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 13structure pred_setScript = 14struct 15(* structure declaration is necessary so that Moscow ML does not get 16 confused by the rebinding of structure Q below *) 17 18open HolKernel Parse boolLib Prim_rec pairLib numLib 19 pairTheory numTheory prim_recTheory arithmeticTheory whileTheory 20 BasicProvers metisLib mesonLib simpLib boolSimps; 21 22val AP = numLib.ARITH_PROVE 23val ARITH_ss = numSimps.ARITH_ss 24val arith_ss = bool_ss ++ ARITH_ss 25val DECIDE = numLib.ARITH_PROVE 26 27(* don't eta-contract these; that will force tactics to use one fixed version 28 of srw_ss() *) 29fun fs thl = FULL_SIMP_TAC (srw_ss() ++ ARITH_ss) thl 30fun simp thl = ASM_SIMP_TAC (srw_ss() ++ ARITH_ss) thl 31fun rw thl = SRW_TAC[ARITH_ss]thl 32 33fun store_thm(r as(n,t,tac)) = let 34 val th = boolLib.store_thm r 35in 36 if String.isPrefix "IN_" n then let 37 val stem0 = String.extract(n,3,NONE) 38 val stem = Substring.full stem0 39 |> Substring.position "[" 40 |> #1 |> Substring.string 41 in 42 if isSome (CharVector.find (equal #"_") stem) then th 43 else 44 case Lib.total (#1 o strip_comb o lhs o #2 o strip_forall o concl) th of 45 NONE => th 46 | SOME t => 47 if same_const t IN_tm then let 48 val applied_thm = SIMP_RULE bool_ss [SimpLHS, IN_DEF] th 49 val applied_name = stem ^ "_applied" 50 in 51 save_thm(applied_name, applied_thm) 52 ; export_rewrites [applied_name] 53 ; th 54 end 55 else th 56 end 57 else th 58end 59structure Q = struct 60 val foo = store_thm 61 open Q 62 fun store_thm(n,q,tac) = 63 let val t = Parse.typed_parse_in_context Type.bool [] q 64 in 65 foo(n,t,tac) 66 end 67end 68 69(* from util_prob *) 70fun K_TAC _ = ALL_TAC; 71val Know = Q_TAC KNOW_TAC; 72val Suff = Q_TAC SUFF_TAC; 73val Cond = 74 MATCH_MP_TAC (PROVE [] ``!a b c. a /\ (b ==> c) ==> ((a ==> b) ==> c)``) \\ 75 CONJ_TAC; 76 77(* ---------------------------------------------------------------------*) 78(* Create the new theory. *) 79(* ---------------------------------------------------------------------*) 80 81val _ = new_theory "pred_set"; 82 83Type set = ���:'a -> bool���; 84 85local open OpenTheoryMap 86 val ns = ["Set"] 87in 88 fun ot0 x y = OpenTheory_const_name{const={Thy="pred_set",Name=x},name=(ns,y)} 89 fun ot x = ot0 x x 90end 91 92(* =====================================================================*) 93(* Membership. *) 94(* =====================================================================*) 95 96(* ---------------------------------------------------------------------*) 97(* The axiom of specification: x IN {y | P y} iff P x *) 98(* ---------------------------------------------------------------------*) 99 100val SPECIFICATION = store_thm( 101 "SPECIFICATION", 102 ���!P x. $IN (x:'a) (P:'a set) = P x���, 103 REWRITE_TAC [IN_DEF] THEN BETA_TAC THEN REWRITE_TAC []); 104 105val IN_APP = Tactical.store_thm ( 106 "IN_APP", 107 ``!x P. (x IN P) = P x``, 108 SIMP_TAC bool_ss [IN_DEF]); 109 110val IN_ABS = Tactical.store_thm ( 111 "IN_ABS", 112 ``!x P. (x IN \x. P x) = P x``, 113 SIMP_TAC bool_ss [IN_DEF]); 114val _ = export_rewrites ["IN_ABS"] 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 144val NUM_SET_WOP = 145 store_thm 146 ("NUM_SET_WOP", 147 (���!s. (?n. n IN s) = ?n. n IN s /\ (!m. m IN s ==> n <= m)���), 148 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 149 [let val th = BETA_RULE (ISPEC (���\n:num. n IN s���) WOP) 150 in IMP_RES_THEN (X_CHOOSE_THEN (���N:num���) STRIP_ASSUME_TAC) th 151 end THEN EXISTS_TAC (���N:num���) THEN CONJ_TAC THENL 152 [FIRST_ASSUM ACCEPT_TAC, 153 GEN_TAC THEN CONV_TAC CONTRAPOS_CONV THEN 154 ASM_REWRITE_TAC [GSYM NOT_LESS]], 155 EXISTS_TAC (���n:num���) THEN FIRST_ASSUM ACCEPT_TAC]); 156 157(* ===================================================================== *) 158(* Generalized set specification. *) 159(* ===================================================================== *) 160val GSPEC_DEF_LEMMA = prove( 161 ���?g:('b->('a#bool))-> 'a set. 162 !f. !v:'a. v IN (g f) <=> ?x:'b. (v,T) = f x���, 163 EXISTS_TAC (���\f. \y:'a. ?x:'b. (y,T) = f x���) THEN 164 REPEAT GEN_TAC THEN 165 PURE_ONCE_REWRITE_TAC [SPECIFICATION] THEN 166 CONV_TAC (DEPTH_CONV BETA_CONV) THEN 167 REFL_TAC); 168 169(* --------------------------------------------------------------------- *) 170(* generalized axiom of specification: *) 171(* *) 172(* GSPECIFICATION = |- !f v. v IN (GSPEC f) = (?x. v,T = f x) *) 173(* --------------------------------------------------------------------- *) 174 175val GSPECIFICATION = new_specification 176 ("GSPECIFICATION", ["GSPEC"], GSPEC_DEF_LEMMA); 177val _ = TeX_notation {hol = "|", TeX = ("\\HOLTokenBar{}", 1)} 178val _ = ot0 "GSPEC" "specification" 179 180val _ = add_user_printer ("pred_set.GSPEC", ``GSPEC f``) 181 182 183val GSPECIFICATION_applied = save_thm( 184 "GSPECIFICATION_applied[simp]", 185 REWRITE_RULE [SPECIFICATION] GSPECIFICATION); 186 187(* --------------------------------------------------------------------- *) 188(* load generalized specification code. *) 189(* --------------------------------------------------------------------- *) 190 191val SET_SPEC_CONV = PGspec.SET_SPEC_CONV GSPECIFICATION; 192 193val SET_SPEC_ss = SSFRAG 194 {name=SOME"SET_SPEC", 195 ac=[], congs=[], dprocs=[], filter=NONE, rewrs=[], 196 convs = [{conv = K (K SET_SPEC_CONV), 197 key = SOME([], ``x IN GSPEC f``), 198 name = "SET_SPEC_CONV", trace = 2}]} 199 200val _ = augment_srw_ss [SET_SPEC_ss] 201 202 203(* --------------------------------------------------------------------- *) 204(* activate generalized specification parser/pretty-printer. *) 205(* --------------------------------------------------------------------- *) 206(* define_set_abstraction_syntax "GSPEC"; *) 207(* set_flag("print_set",true); *) 208 209val _ = add_rule{term_name = "gspec special", fixity = Closefix, 210 pp_elements = [TOK "{", TM, HardSpace 1, TOK "|", 211 BreakSpace(1,0),TM, TOK "}"], 212 paren_style = OnlyIfNecessary, 213 block_style = (AroundEachPhrase, (PP.CONSISTENT, 0))}; 214 215val _ = add_rule{term_name = "gspec2 special", fixity = Closefix, 216 pp_elements = [TOK "{",TM, TOK "|", TM, TOK "|", TM, TOK "}"], 217 paren_style = OnlyIfNecessary, 218 block_style = (AroundEachPhrase, (PP.CONSISTENT, 0))} 219 220val GSPEC_ETA = store_thm( 221 "GSPEC_ETA", 222 ``{x | P x} = P``, 223 SRW_TAC [] [EXTENSION, SPECIFICATION]); 224 225val GSPEC_PAIR_ETA = store_thm( 226 "GSPEC_PAIR_ETA", 227 ``{(x,y) | P x y} = UNCURRY P``, 228 SRW_TAC [] [EXTENSION, SPECIFICATION] THEN EQ_TAC THEN STRIP_TAC 229 THENL [ ASM_REWRITE_TAC [UNCURRY_DEF], 230 Q.EXISTS_TAC `FST x` THEN 231 Q.EXISTS_TAC `SND x` THEN 232 FULL_SIMP_TAC std_ss [UNCURRY] ]) ; 233 234val IN_GSPEC_IFF = store_thm ("IN_GSPEC_IFF", 235 ``y IN {x | P x} <=> P y``, 236 REWRITE_TAC [GSPEC_ETA, SPECIFICATION]) ; 237 238val PAIR_IN_GSPEC_IFF = store_thm ("PAIR_IN_GSPEC_IFF", 239 ``(x,y) IN {(x,y) | P x y} <=> P x y``, 240 REWRITE_TAC [GSPEC_PAIR_ETA, UNCURRY_DEF, SPECIFICATION]) ; 241 242val IN_GSPEC = store_thm ("IN_GSPEC", 243 ``!y x P. P y /\ (x = f y) ==> x IN {f x | P x}``, 244 REWRITE_TAC [GSPECIFICATION] THEN REPEAT STRIP_TAC THEN 245 Q.EXISTS_TAC `y` THEN ASM_SIMP_TAC std_ss []) ; 246 247val PAIR_IN_GSPEC_1 = Q.store_thm ("PAIR_IN_GSPEC_1", 248 `(a,b) IN {(y,x) | y | P y} <=> P a /\ (b = x)`, 249 SIMP_TAC bool_ss [GSPECIFICATION, 250 combinTheory.o_THM, FST, SND, PAIR_EQ] THEN 251 MATCH_ACCEPT_TAC CONJ_COMM) ; 252 253val PAIR_IN_GSPEC_2 = Q.store_thm ("PAIR_IN_GSPEC_2", 254 `(a,b) IN {(x,y) | y | P y} <=> P b /\ (a = x)`, 255 SIMP_TAC bool_ss [GSPECIFICATION, 256 combinTheory.o_THM, FST, SND, PAIR_EQ] THEN 257 MATCH_ACCEPT_TAC CONJ_COMM) ; 258 259val PAIR_IN_GSPEC_same = Q.store_thm ("PAIR_IN_GSPEC_same", 260 `(a,b) IN {(x,x) | P x} <=> P a /\ (a = b)`, 261 SIMP_TAC bool_ss [GSPECIFICATION, 262 combinTheory.o_THM, FST, SND, PAIR_EQ] THEN 263 EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []) ; 264 265(* the phrase "gspec special" is dealt with in the translation from 266 pre-pre-terms to terms *) 267 268(* --------------------------------------------------------------------- *) 269(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *) 270(* --------------------------------------------------------------------- *) 271 272val lemma = 273 TAC_PROOF 274 (([], (���!s x. x IN s ==> !f:'a->'b. (f x) IN {f x | x IN s}���)), 275 REPEAT STRIP_TAC THEN CONV_TAC SET_SPEC_CONV THEN 276 EXISTS_TAC (���x:'a���) THEN ASM_REWRITE_TAC[]); 277 278Theorem SET_MINIMUM: 279 !s:'a -> bool. !M. 280 (?x. x IN s) <=> ?x. x IN s /\ !y. y IN s ==> M x <= M y 281Proof 282 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 283 [IMP_RES_THEN (ASSUME_TAC o ISPEC (���M:'a->num���)) lemma THEN 284 let val th = SET_SPEC_CONV (���(n:num) IN {M x | (x:'a) IN s}���) 285 in IMP_RES_THEN (STRIP_ASSUME_TAC o REWRITE_RULE [th]) NUM_SET_WOP 286 end THEN EXISTS_TAC (���x':'a���) THEN CONJ_TAC THENL 287 [FIRST_ASSUM ACCEPT_TAC, 288 FIRST_ASSUM (SUBST_ALL_TAC o SYM) THEN 289 REPEAT STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN 290 EXISTS_TAC (���y:'a���) THEN CONJ_TAC THENL 291 [REFL_TAC, FIRST_ASSUM ACCEPT_TAC]], 292 EXISTS_TAC (���x:'a���) THEN FIRST_ASSUM ACCEPT_TAC] 293QED 294 295 296(* ===================================================================== *) 297(* The empty set *) 298(* ===================================================================== *) 299 300val EMPTY_DEF = new_definition 301 ("EMPTY_DEF", (���EMPTY = (\x:'a.F)���)); 302open Unicode 303val _ = overload_on (UChar.emptyset, ``pred_set$EMPTY``) 304val _ = TeX_notation {hol = UChar.emptyset, TeX = ("\\HOLTokenEmpty{}", 1)} 305val _ = ot0 "EMPTY" "{}" 306 307val NOT_IN_EMPTY = 308 store_thm 309 ("NOT_IN_EMPTY", 310 (���!x:'a.~(x IN EMPTY)���), 311 PURE_REWRITE_TAC [EMPTY_DEF,SPECIFICATION] THEN 312 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN 313 REPEAT STRIP_TAC); 314 315val _ = export_rewrites ["NOT_IN_EMPTY"] 316 317val MEMBER_NOT_EMPTY = 318 store_thm 319 ("MEMBER_NOT_EMPTY", 320 (���!s:'a set. (?x. x IN s) = ~(s = EMPTY)���), 321 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY] THEN 322 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 323 REWRITE_TAC [NOT_CLAUSES]); 324 325val EMPTY_applied = store_thm( 326 "EMPTY_applied", 327 ``EMPTY x <=> F``, 328 REWRITE_TAC [EMPTY_DEF]) 329val _ = export_rewrites ["EMPTY_applied"] 330 331(* ===================================================================== *) 332(* The set of everything *) 333(* ===================================================================== *) 334 335val UNIV_DEF = new_definition 336 ("UNIV_DEF",(���UNIV = (\x:'a.T)���)); 337 338val _ = ot0 "UNIV" "universe" 339 340val IN_UNIV = 341 store_thm 342 ("IN_UNIV", 343 (���!x:'a. x IN UNIV���), 344 GEN_TAC THEN PURE_REWRITE_TAC [UNIV_DEF,SPECIFICATION] THEN 345 CONV_TAC BETA_CONV THEN ACCEPT_TAC TRUTH); 346val _ = export_rewrites ["IN_UNIV"] 347val UNIV_applied = save_thm( 348 "UNIV_applied[simp]", 349 REWRITE_RULE[SPECIFICATION] IN_UNIV); 350 351val UNIV_NOT_EMPTY = 352 store_thm 353 ("UNIV_NOT_EMPTY", 354 (���~(UNIV:'a set = EMPTY)���), 355 REWRITE_TAC [EXTENSION,IN_UNIV,NOT_IN_EMPTY]); 356val _ = export_rewrites ["UNIV_NOT_EMPTY"] 357 358val EMPTY_NOT_UNIV = 359 store_thm 360 ("EMPTY_NOT_UNIV", 361 (���~(EMPTY = (UNIV:'a set))���), 362 REWRITE_TAC [EXTENSION,IN_UNIV,NOT_IN_EMPTY]); 363 364val EQ_UNIV = 365 store_thm 366 ("EQ_UNIV", 367 (���(!x:'a. x IN s) = (s = UNIV)���), 368 REWRITE_TAC [EXTENSION,IN_UNIV]); 369 370val IN_EQ_UNIV_IMP = store_thm (* from util_prob *) 371 ("IN_EQ_UNIV_IMP", 372 ``!s. (s = UNIV) ==> !v. (v : 'a) IN s``, 373 RW_TAC std_ss [IN_UNIV]); 374 375val _ = overload_on ("univ", ``\x:'a itself. UNIV : 'a set``) 376val _ = set_fixity "univ" (Prefix 2200) 377 378val _ = overload_on (UnicodeChars.universal_set, ``\x:'a itself. UNIV: 'a set``) 379val _ = set_fixity UnicodeChars.universal_set (Prefix 2200) 380(* the overloads above are only for parsing; printing for this is handled 381 with a user-printer. (Otherwise the fact that the x is not bound in the 382 abstraction produces ARB terms.) To turn printing off, we overload the 383 same pattern to "" *) 384val _ = overload_on ("", ���\x:'a itself. UNIV : 'a set���) 385local open pred_setpp in end 386val _ = add_ML_dependency "pred_setpp" 387val _ = add_user_printer ("pred_set.UNIV", ``UNIV:'a set``) 388 389val _ = TeX_notation {hol = "univ", TeX = ("\\ensuremath{{\\cal{U}}}", 1)} 390val _ = TeX_notation {hol = UnicodeChars.universal_set, 391 TeX = ("\\ensuremath{{\\cal{U}}}", 1)} 392 393 394(* ===================================================================== *) 395(* Set inclusion. *) 396(* ===================================================================== *) 397 398val SUBSET_DEF = new_definition( 399 "SUBSET_DEF", 400 ``$SUBSET s t = !x:'a. x IN s ==> x IN t``); 401val _ = set_fixity "SUBSET" (Infix(NONASSOC, 450)) 402val _ = unicode_version { u = UChar.subset, tmnm = "SUBSET"}; 403val _ = TeX_notation {hol = "SUBSET", TeX = ("\\HOLTokenSubset{}", 1)} 404val _ = TeX_notation {hol = UChar.subset, TeX = ("\\HOLTokenSubset{}", 1)} 405val _ = ot0 "SUBSET" "subset" 406 407val SUBSET_THM = store_thm (* from util_prob *) 408 ("SUBSET_THM", 409 ``!(P : 'a -> bool) Q. P SUBSET Q ==> (!x. x IN P ==> x IN Q)``, 410 RW_TAC std_ss [SUBSET_DEF]); 411 412val SUBSET_applied = save_thm 413 ("SUBSET_applied", SIMP_RULE bool_ss [IN_DEF] SUBSET_DEF); 414 415Theorem SUBSET_TRANS: 416 !(s:'a set) t u. s SUBSET t /\ t SUBSET u ==> s SUBSET u 417Proof 418 REWRITE_TAC [SUBSET_DEF] THEN 419 REPEAT STRIP_TAC THEN 420 REPEAT (FIRST_ASSUM MATCH_MP_TAC) THEN 421 FIRST_ASSUM ACCEPT_TAC 422QED 423 424Theorem SUBSET_transitive[simp]: 425 transitive (SUBSET) 426Proof 427 METIS_TAC[relationTheory.transitive_def, SUBSET_TRANS] 428QED 429 430Theorem SUBSET_REFL[simp]: 431 !(s:'a set). s SUBSET s 432Proof REWRITE_TAC[SUBSET_DEF] 433QED 434 435Theorem SUBSET_reflexive[simp]: 436 reflexive (SUBSET) 437Proof SRW_TAC[][relationTheory.reflexive_def] 438QED 439 440(* would prefer to avoid the _THM suffix but the names without are already 441 claimed by relationTheory for thms of the form R x y ==> OP R x y *) 442Theorem RC_SUBSET_THM[simp]: 443 RC(SUBSET) = (SUBSET) 444Proof 445 simp[relationTheory.reflexive_RC_identity] 446QED 447 448Theorem TC_SUBSET_THM[simp]: 449 TC(SUBSET) = (SUBSET) 450Proof 451 SRW_TAC[][relationTheory.transitive_TC_identity] 452QED 453 454Theorem RTC_SUBSET_THM[simp]: 455 RTC (SUBSET) = (SUBSET) 456Proof 457 simp[GSYM relationTheory.TC_RC_EQNS] 458QED 459 460Theorem SUBSET_ANTISYM: 461 !(s:'a set) t. (s SUBSET t) /\ (t SUBSET s) ==> (s = t) 462Proof 463 REWRITE_TAC [SUBSET_DEF, EXTENSION] THEN 464 REPEAT STRIP_TAC THEN 465 EQ_TAC THEN 466 FIRST_ASSUM MATCH_ACCEPT_TAC 467QED 468 469Theorem EMPTY_SUBSET[simp]: 470 !s:'a set. EMPTY SUBSET s 471Proof REWRITE_TAC [SUBSET_DEF,NOT_IN_EMPTY] 472QED 473 474Theorem SUBSET_EMPTY[simp]: 475 !s:'a set. s SUBSET EMPTY <=> (s = EMPTY) 476Proof 477 PURE_REWRITE_TAC [SUBSET_DEF,NOT_IN_EMPTY] THEN 478 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY] 479QED 480 481val SUBSET_UNIV = 482 store_thm 483 ("SUBSET_UNIV", 484 (���!s:'a set. s SUBSET UNIV���), 485 REWRITE_TAC [SUBSET_DEF,IN_UNIV]); 486val _ = export_rewrites ["SUBSET_UNIV"] 487 488Theorem UNIV_SUBSET[simp]: 489 !s:'a set. UNIV SUBSET s <=> (s = UNIV) 490Proof REWRITE_TAC [SUBSET_DEF,IN_UNIV,EXTENSION] 491QED 492 493val EQ_SUBSET_SUBSET = store_thm (* from util_prob *) 494 ("EQ_SUBSET_SUBSET", 495 ``!(s :'a -> bool) t. (s = t) ==> s SUBSET t /\ t SUBSET s``, 496 RW_TAC std_ss [SUBSET_DEF, EXTENSION]); 497 498Theorem SUBSET_ANTISYM_EQ : (* from HOL Light *) 499 !(s:'a set) t. (s SUBSET t) /\ (t SUBSET s) <=> (s = t) 500Proof 501 REPEAT GEN_TAC THEN EQ_TAC THENL 502 [REWRITE_TAC [SUBSET_ANTISYM], 503 REWRITE_TAC [EQ_SUBSET_SUBSET]] 504QED 505 506Theorem SET_EQ_SUBSET = GSYM SUBSET_ANTISYM_EQ; 507 508val SUBSET_ADD = store_thm (* from util_prob *) 509 ("SUBSET_ADD", 510 ``!f n d. 511 (!n. f n SUBSET f (SUC n)) ==> 512 f n SUBSET f (n + d)``, 513 RW_TAC std_ss [] 514 >> Induct_on `d` >- RW_TAC arith_ss [SUBSET_REFL] 515 >> RW_TAC std_ss [ADD_CLAUSES] 516 >> MATCH_MP_TAC SUBSET_TRANS 517 >> Q.EXISTS_TAC `f (n + d)` 518 >> RW_TAC std_ss []); 519 520val K_DEF = combinTheory.K_DEF; 521 522val K_SUBSET = store_thm (* from util_prob *) 523 ("K_SUBSET", 524 ``!x y. K x SUBSET y <=> ~x \/ (UNIV SUBSET y)``, 525 RW_TAC std_ss [K_DEF, SUBSET_DEF, IN_UNIV] 526 >> RW_TAC std_ss [SPECIFICATION] 527 >> PROVE_TAC []); 528 529val SUBSET_K = store_thm (* from util_prob *) 530 ("SUBSET_K", 531 ``!x y. x SUBSET K y <=> (x SUBSET EMPTY) \/ y``, 532 RW_TAC std_ss [K_DEF, SUBSET_DEF, NOT_IN_EMPTY] 533 >> RW_TAC std_ss [SPECIFICATION] 534 >> PROVE_TAC []); 535 536(* ===================================================================== *) 537(* Proper subset. *) 538(* ===================================================================== *) 539 540val PSUBSET_DEF = new_definition( 541 "PSUBSET_DEF", 542 ``PSUBSET (s:'a set) t <=> s SUBSET t /\ ~(s = t)``); 543val _ = set_fixity "PSUBSET" (Infix(NONASSOC, 450)) 544val _ = unicode_version { u = UTF8.chr 0x2282, tmnm = "PSUBSET"} 545val _ = TeX_notation {hol = "PSUBSET", TeX = ("\\HOLTokenPSubset", 1)} 546val _ = TeX_notation {hol = UTF8.chr 0x2282, TeX = ("\\HOLTokenPSubset", 1)} 547val _ = ot0 "PSUBSET" "properSubset" 548 549Theorem PSUBSET_TRANS: 550 !s:'a set. !t u. (s PSUBSET t /\ t PSUBSET u) ==> (s PSUBSET u) 551Proof 552 PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN 553 REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL [ 554 IMP_RES_TAC SUBSET_TRANS, 555 DISCH_THEN SUBST_ALL_TAC THEN 556 IMP_RES_TAC SUBSET_ANTISYM THEN 557 RES_TAC 558 ] 559QED 560 561Theorem transitive_PSUBSET[simp]: 562 transitive (PSUBSET) 563Proof 564 METIS_TAC[relationTheory.transitive_def, PSUBSET_TRANS] 565QED 566 567Theorem PSUBSET_IRREFL[simp]: 568 !s:'a set. ~(s PSUBSET s) 569Proof 570 REWRITE_TAC [PSUBSET_DEF,SUBSET_REFL] 571QED 572 573Theorem RC_PSUBSET[simp]: 574 RC (PSUBSET) = (SUBSET) 575Proof 576 simp[PSUBSET_DEF, Ntimes FUN_EQ_THM 2, relationTheory.RC_DEF, EQ_IMP_THM, 577 DISJ_IMP_THM] 578QED 579 580Theorem TC_PSUBSET[simp]: 581 TC (PSUBSET) = (PSUBSET) 582Proof 583 simp[relationTheory.transitive_TC_identity] 584QED 585 586Theorem RTC_PSUBSET[simp]: 587 RTC (PSUBSET) = (SUBSET) 588Proof 589 simp[GSYM relationTheory.TC_RC_EQNS] 590QED 591 592Theorem NOT_PSUBSET_EMPTY[simp]: 593 !s:'a set. ~(s PSUBSET EMPTY) 594Proof 595 REWRITE_TAC [PSUBSET_DEF,SUBSET_EMPTY,NOT_AND] 596QED 597 598Theorem NOT_UNIV_PSUBSET[simp]: 599 !s:'a set. ~(UNIV PSUBSET s) 600Proof 601 REWRITE_TAC [PSUBSET_DEF,UNIV_SUBSET,DE_MORGAN_THM] THEN 602 METIS_TAC[] 603QED 604 605val PSUBSET_UNIV = 606 store_thm 607 ("PSUBSET_UNIV", 608 (���!s:'a set. (s PSUBSET UNIV) = ?x:'a. ~(x IN s)���), 609 REWRITE_TAC [PSUBSET_DEF,SUBSET_UNIV,EXTENSION,IN_UNIV] THEN 610 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN GEN_TAC THEN REFL_TAC); 611 612(* ===================================================================== *) 613(* Union *) 614(* ===================================================================== *) 615 616val UNION_DEF = new_infixl_definition 617 ("UNION_DEF", (���UNION s t = {x:'a | x IN s \/ x IN t}���),500); 618val _ = unicode_version{ u = UChar.union, tmnm = "UNION"} 619val _ = TeX_notation {hol = "UNION", TeX = ("\\HOLTokenUnion{}", 1)} 620val _ = TeX_notation {hol = UChar.union, TeX = ("\\HOLTokenUnion{}", 1)} 621val _ = ot0 "UNION" "union" 622 623Theorem IN_UNION[simp]: 624 !s t (x:'a). x IN (s UNION t) <=> x IN s \/ x IN t 625Proof 626 PURE_ONCE_REWRITE_TAC [UNION_DEF] THEN 627 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN 628 REPEAT GEN_TAC THEN REFL_TAC 629QED 630 631val UNION_ASSOC = store_thm 632 ("UNION_ASSOC", 633 (���!(s:'a set) t u. s UNION (t UNION u) = (s UNION t) UNION u���), 634 REWRITE_TAC [EXTENSION, IN_UNION] THEN 635 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 636 ASM_REWRITE_TAC[]); 637 638val UNION_IDEMPOT = store_thm 639 ("UNION_IDEMPOT", 640 (���!(s:'a set). s UNION s = s���), 641 REWRITE_TAC[EXTENSION, IN_UNION]); 642 643val UNION_COMM = store_thm 644 ("UNION_COMM", 645 (���!(s:'a set) t. s UNION t = t UNION s���), 646 REWRITE_TAC[EXTENSION, IN_UNION] THEN 647 REPEAT GEN_TAC THEN MATCH_ACCEPT_TAC DISJ_SYM); 648 649val SUBSET_UNION = 650 store_thm 651 ("SUBSET_UNION", 652 (���(!s:'a set. !t. s SUBSET (s UNION t)) /\ 653 (!s:'a set. !t. s SUBSET (t UNION s))���), 654 PURE_REWRITE_TAC [SUBSET_DEF,IN_UNION] THEN 655 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]); 656 657Theorem UNION_SUBSET: 658 !s t u. (s UNION t) SUBSET u <=> s SUBSET u /\ t SUBSET u 659Proof PROVE_TAC [IN_UNION, SUBSET_DEF] 660QED 661 662Theorem SUBSET_UNION_ABSORPTION: 663 !s:'a set. !t. s SUBSET t <=> (s UNION t = t) 664Proof 665 REWRITE_TAC [SUBSET_DEF,EXTENSION,IN_UNION] THEN 666 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 667 [RES_TAC,ASM_REWRITE_TAC[],RES_TAC] 668QED 669 670val UNION_EMPTY = 671 store_thm 672 ("UNION_EMPTY", 673 (���(!s:'a set. EMPTY UNION s = s) /\ 674 (!s:'a set. s UNION EMPTY = s)���), 675 REWRITE_TAC [IN_UNION,EXTENSION,NOT_IN_EMPTY]); 676 677val _ = export_rewrites ["UNION_EMPTY"] 678 679val UNION_UNIV = 680 store_thm 681 ("UNION_UNIV", 682 (���(!s:'a set. UNIV UNION s = UNIV) /\ 683 (!s:'a set. s UNION UNIV = UNIV)���), 684 REWRITE_TAC [IN_UNION,EXTENSION,IN_UNIV]); 685 686val _ = export_rewrites ["UNION_UNIV"] 687 688val EMPTY_UNION = store_thm("EMPTY_UNION", 689(���!s:'a set. !t. (s UNION t = EMPTY) = ((s = EMPTY) /\ (t = EMPTY))���), 690 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_UNION,DE_MORGAN_THM] THEN 691 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC); 692val _ = export_rewrites ["EMPTY_UNION"] 693 694(* from probability/iterateTheory *) 695val FORALL_IN_UNION = store_thm 696 ("FORALL_IN_UNION", 697 ``!P s t:'a->bool. (!x. x IN s UNION t ==> P x) <=> 698 (!x. x IN s ==> P x) /\ (!x. x IN t ==> P x)``, 699 REWRITE_TAC [IN_UNION] THEN PROVE_TAC []); 700 701(* ===================================================================== *) 702(* Intersection *) 703(* ===================================================================== *) 704 705val INTER_DEF = new_infixl_definition 706 ("INTER_DEF", 707 (���INTER s t = {x:'a | x IN s /\ x IN t}���), 600); 708val _ = unicode_version{ u = UChar.inter, tmnm = "INTER"}; 709val _ = TeX_notation {hol = "INTER", TeX = ("\\HOLTokenInter{}", 1)} 710val _ = TeX_notation {hol = UChar.inter, TeX = ("\\HOLTokenInter{}", 1)} 711val _ = ot0 "INTER" "intersect" 712 713Theorem IN_INTER[simp]: 714 !s t (x:'a). x IN (s INTER t) <=> x IN s /\ x IN t 715Proof 716 PURE_ONCE_REWRITE_TAC [INTER_DEF] THEN 717 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN 718 REPEAT GEN_TAC THEN REFL_TAC 719QED 720 721val INTER_ASSOC = store_thm 722 ("INTER_ASSOC", 723 (���!(s:'a set) t u. s INTER (t INTER u) = (s INTER t) INTER u���), 724 REWRITE_TAC [EXTENSION, IN_INTER, CONJ_ASSOC]); 725 726val INTER_IDEMPOT = store_thm 727 ("INTER_IDEMPOT", 728 (���!(s:'a set). s INTER s = s���), 729 REWRITE_TAC[EXTENSION, IN_INTER]); 730 731val INTER_COMM = store_thm 732 ("INTER_COMM", 733 (���!(s:'a set) t. s INTER t = t INTER s���), 734 REWRITE_TAC[EXTENSION, IN_INTER] THEN 735 REPEAT GEN_TAC THEN 736 MATCH_ACCEPT_TAC CONJ_SYM); 737 738val INTER_SUBSET = 739 store_thm 740 ("INTER_SUBSET", 741 (���(!s:'a set. !t. (s INTER t) SUBSET s) /\ 742 (!s:'a set. !t. (t INTER s) SUBSET s)���), 743 PURE_REWRITE_TAC [SUBSET_DEF,IN_INTER] THEN 744 REPEAT STRIP_TAC); 745 746Theorem SUBSET_INTER: 747 !s t u. s SUBSET (t INTER u) <=> s SUBSET t /\ s SUBSET u 748Proof PROVE_TAC [IN_INTER, SUBSET_DEF] 749QED 750 751Theorem SUBSET_INTER_ABSORPTION: 752 !s:'a set. !t. s SUBSET t <=> (s INTER t = s) 753Proof 754 REWRITE_TAC [SUBSET_DEF,EXTENSION,IN_INTER] THEN 755 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 756 [FIRST_ASSUM ACCEPT_TAC, RES_TAC, RES_TAC] 757QED 758 759val SUBSET_INTER1 = store_thm (* from util_prob *) 760 ("SUBSET_INTER1", 761 ``!s t. s SUBSET t ==> (s INTER t = s)``, 762 RW_TAC std_ss [EXTENSION,GSPECIFICATION,SUBSET_DEF, IN_INTER] 763 >> PROVE_TAC []); 764 765val SUBSET_INTER2 = store_thm (* from util_prob *) 766 ("SUBSET_INTER2", 767 ``!s t. s SUBSET t ==> (t INTER s = s)``, 768 RW_TAC std_ss [EXTENSION,GSPECIFICATION,SUBSET_DEF, IN_INTER] 769 >> PROVE_TAC []); 770 771val INTER_EMPTY = 772 store_thm 773 ("INTER_EMPTY", 774 (���(!s:'a set. EMPTY INTER s = EMPTY) /\ 775 (!s:'a set. s INTER EMPTY = EMPTY)���), 776 REWRITE_TAC [IN_INTER,EXTENSION,NOT_IN_EMPTY]); 777 778val _ = export_rewrites ["INTER_EMPTY"] 779 780val INTER_UNIV = 781 store_thm 782 ("INTER_UNIV", 783 (���(!s:'a set. UNIV INTER s = s) /\ 784 (!s:'a set. s INTER UNIV = s)���), 785 REWRITE_TAC [IN_INTER,EXTENSION,IN_UNIV]); 786 787(* ===================================================================== *) 788(* Distributivity *) 789(* ===================================================================== *) 790 791val UNION_OVER_INTER = store_thm 792 ("UNION_OVER_INTER", 793 (���!s:'a set. !t u. 794 s INTER (t UNION u) = (s INTER t) UNION (s INTER u)���), 795 REWRITE_TAC [EXTENSION,IN_INTER,IN_UNION] THEN 796 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 797 ASM_REWRITE_TAC[]); 798 799val INTER_OVER_UNION = store_thm 800 ("INTER_OVER_UNION", 801 (���!s:'a set. !t u. 802 s UNION (t INTER u) = (s UNION t) INTER (s UNION u)���), 803 REWRITE_TAC [EXTENSION,IN_INTER,IN_UNION] THEN 804 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 805 ASM_REWRITE_TAC[]); 806 807(* ===================================================================== *) 808(* Disjoint sets. *) 809(* ===================================================================== *) 810 811val DISJOINT_DEF = new_definition ("DISJOINT_DEF", 812(���DISJOINT (s:'a set) t = ((s INTER t) = EMPTY)���)); 813 814val IN_DISJOINT = 815 store_thm 816 ("IN_DISJOINT", 817 (���!s:'a set. !t. DISJOINT s t = ~(?x. x IN s /\ x IN t)���), 818 REWRITE_TAC [DISJOINT_DEF,EXTENSION,IN_INTER,NOT_IN_EMPTY] THEN 819 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN 820 REPEAT GEN_TAC THEN REFL_TAC); 821 822val DISJOINT_SYM = 823 store_thm 824 ("DISJOINT_SYM", 825 (���!s:'a set. !t. DISJOINT s t = DISJOINT t s���), 826 PURE_ONCE_REWRITE_TAC [DISJOINT_DEF] THEN REPEAT GEN_TAC THEN 827 SUBST1_TAC (SPECL [���s:'a set���, ���t:'a set���] INTER_COMM) THEN 828 REFL_TAC); 829 830val DISJOINT_ALT = store_thm (* from util_prob *) 831 ("DISJOINT_ALT", 832 ``!s t. DISJOINT s t = !x. x IN s ==> ~(x IN t)``, 833 RW_TAC std_ss [IN_DISJOINT] 834 >> PROVE_TAC []); 835 836(* --------------------------------------------------------------------- *) 837(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *) 838(* --------------------------------------------------------------------- *) 839val DISJOINT_EMPTY = 840 store_thm 841 ("DISJOINT_EMPTY", 842 (���!s:'a set. DISJOINT EMPTY s /\ DISJOINT s EMPTY���), 843 REWRITE_TAC [DISJOINT_DEF,INTER_EMPTY]); 844 845val DISJOINT_EMPTY_REFL = 846 store_thm 847 ("DISJOINT_EMPTY_REFL", 848 (���!s:'a set. (s = EMPTY) = (DISJOINT s s)���), 849 REWRITE_TAC [DISJOINT_DEF,INTER_IDEMPOT]); 850val DISJOINT_EMPTY_REFL_RWT = save_thm( 851 "DISJOINT_EMPTY_REFL_RWT", 852 ONCE_REWRITE_RULE [EQ_SYM_EQ] DISJOINT_EMPTY_REFL) 853 854(* --------------------------------------------------------------------- *) 855(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *) 856(* --------------------------------------------------------------------- *) 857Theorem DISJOINT_UNION: 858 !(s:'a set) t u. DISJOINT (s UNION t) u <=> DISJOINT s u /\ DISJOINT t u 859Proof 860 REWRITE_TAC [IN_DISJOINT,IN_UNION] THEN 861 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN 862 CONV_TAC (ONCE_DEPTH_CONV AND_FORALL_CONV) THEN 863 REWRITE_TAC [DE_MORGAN_THM,RIGHT_AND_OVER_OR] THEN 864 REPEAT GEN_TAC THEN EQ_TAC THEN 865 DISCH_THEN(fn th => GEN_TAC THEN 866 STRIP_ASSUME_TAC (SPEC (���x:'a���) th)) THEN 867 ASM_REWRITE_TAC [] 868QED 869 870Theorem DISJOINT_UNION_BOTH: 871 !s t u:'a set. 872 (DISJOINT (s UNION t) u <=> DISJOINT s u /\ DISJOINT t u) /\ 873 (DISJOINT u (s UNION t) <=> DISJOINT s u /\ DISJOINT t u) 874Proof PROVE_TAC [DISJOINT_UNION, DISJOINT_SYM] 875QED 876 877val DISJOINT_SUBSET = Q.store_thm 878("DISJOINT_SUBSET", 879 `!s t u. DISJOINT s t /\ u SUBSET t ==> DISJOINT s u`, 880 REWRITE_TAC [DISJOINT_DEF, SUBSET_DEF, IN_INTER, NOT_IN_EMPTY, 881 EXTENSION] THEN 882 PROVE_TAC []); 883 884val SUBSET_DISJOINT = store_thm 885 ("SUBSET_DISJOINT", 886 ``!s t u v. DISJOINT s t /\ u SUBSET s /\ v SUBSET t ==> DISJOINT u v``, 887 RW_TAC std_ss [DISJOINT_ALT] 888 >> `x IN s` by PROVE_TAC [SUBSET_DEF] 889 >> CCONTR_TAC >> fs [] 890 >> `x IN t` by PROVE_TAC [SUBSET_DEF] 891 >> RES_TAC); 892 893(* ===================================================================== *) 894(* Set difference *) 895(* ===================================================================== *) 896 897val DIFF_DEF = new_infixl_definition 898 ("DIFF_DEF", 899 (���DIFF s t = {x:'a | x IN s /\ ~ (x IN t)}���),500); 900val _ = ot0 "DIFF" "difference" 901 902Theorem IN_DIFF[simp]: 903 !(s:'a set) t x. x IN (s DIFF t) <=> x IN s /\ x NOTIN t 904Proof 905 REPEAT GEN_TAC THEN 906 PURE_ONCE_REWRITE_TAC [DIFF_DEF] THEN 907 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN 908 REFL_TAC 909QED 910 911val DIFF_EMPTY = 912 store_thm 913 ("DIFF_EMPTY", 914 (���!s:'a set. s DIFF EMPTY = s���), 915 GEN_TAC THEN 916 REWRITE_TAC [NOT_IN_EMPTY,IN_DIFF,EXTENSION]); 917 918val EMPTY_DIFF = 919 store_thm 920 ("EMPTY_DIFF", 921 (���!s:'a set. EMPTY DIFF s = EMPTY���), 922 GEN_TAC THEN 923 REWRITE_TAC [NOT_IN_EMPTY,IN_DIFF,EXTENSION]); 924val _ = export_rewrites ["EMPTY_DIFF"] 925 926val DIFF_UNIV = 927 store_thm 928 ("DIFF_UNIV", 929 (���!s:'a set. s DIFF UNIV = EMPTY���), 930 GEN_TAC THEN 931 REWRITE_TAC [NOT_IN_EMPTY,IN_DIFF,IN_UNIV,EXTENSION]); 932 933val DIFF_DIFF = 934 store_thm 935 ("DIFF_DIFF", 936 (���!s:'a set. !t. (s DIFF t) DIFF t = s DIFF t���), 937 REWRITE_TAC [EXTENSION,IN_DIFF,SYM(SPEC_ALL CONJ_ASSOC)]); 938 939val DIFF_EQ_EMPTY = 940 store_thm 941 ("DIFF_EQ_EMPTY", 942 (���!s:'a set. s DIFF s = EMPTY���), 943 REWRITE_TAC [EXTENSION,IN_DIFF,NOT_IN_EMPTY,DE_MORGAN_THM] THEN 944 PURE_ONCE_REWRITE_TAC [DISJ_SYM] THEN 945 REWRITE_TAC [EXCLUDED_MIDDLE]); 946 947val DIFF_SUBSET = Q.store_thm 948("DIFF_SUBSET", 949 `!s t. (s DIFF t) SUBSET s`, 950 REWRITE_TAC [SUBSET_DEF, IN_DIFF] THEN PROVE_TAC []); 951 952val UNION_DIFF = store_thm( 953 "UNION_DIFF", 954 ``s SUBSET t ==> (s UNION (t DIFF s) = t) /\ ((t DIFF s) UNION s = t)``, 955 SRW_TAC [][EXTENSION, SUBSET_DEF] THEN PROVE_TAC []); 956 957val DIFF_DIFF_SUBSET = store_thm 958 ("DIFF_DIFF_SUBSET", ``!s t. (t SUBSET s) ==> (s DIFF (s DIFF t) = t)``, 959 RW_TAC std_ss [DIFF_DEF,IN_INTER,EXTENSION,GSPECIFICATION,SUBSET_DEF] 960 >> EQ_TAC >- RW_TAC std_ss [] 961 >> RW_TAC std_ss []); 962 963val DIFF_UNION = store_thm( 964"DIFF_UNION", 965``!x y z. x DIFF (y UNION z) = x DIFF y DIFF z``, 966SRW_TAC[][EXTENSION] THEN METIS_TAC[]) 967 968Theorem UNION_DIFF_EQ[simp]: 969 (!s t. ((s:'a -> bool) UNION (t DIFF s)) = (s UNION t)) 970 /\ !s t. ((t DIFF s) UNION (s:'a -> bool)) = (t UNION s) 971Proof 972 rw[EXTENSION,EQ_IMP_THM,DIFF_DEF] 973 >> fs[] 974QED 975 976val DIFF_COMM = store_thm( 977"DIFF_COMM", 978``!x y z. x DIFF y DIFF z = x DIFF z DIFF y``, 979SRW_TAC[][EXTENSION] THEN METIS_TAC[]) 980 981val DIFF_SAME_UNION = store_thm( 982"DIFF_SAME_UNION", 983``!x y. ((x UNION y) DIFF x = y DIFF x) /\ ((x UNION y) DIFF y = x DIFF y)``, 984SRW_TAC[][EXTENSION,EQ_IMP_THM]) 985 986val DIFF_INTER = store_thm (* from util_prob *) 987 ("DIFF_INTER", ``!s t g. (s DIFF t) INTER g = s INTER g DIFF t``, 988 RW_TAC std_ss [DIFF_DEF,INTER_DEF,EXTENSION] 989 >> RW_TAC std_ss [GSPECIFICATION] 990 >> EQ_TAC >- RW_TAC std_ss [] >> RW_TAC std_ss []); 991 992val DIFF_INTER2 = store_thm (* from util_prob *) 993 ("DIFF_INTER2", ``!s t. s DIFF (t INTER s) = s DIFF t``, 994 RW_TAC std_ss [DIFF_DEF,INTER_DEF,EXTENSION] 995 >> RW_TAC std_ss [GSPECIFICATION,LEFT_AND_OVER_OR]); 996 997val DISJOINT_DIFF = store_thm (* from util_prob *) 998 ("DISJOINT_DIFF", ``!s t. DISJOINT t (s DIFF t) /\ DISJOINT (s DIFF t) t``, 999 RW_TAC std_ss [EXTENSION, DISJOINT_DEF, IN_INTER, NOT_IN_EMPTY, IN_DIFF] 1000 >> METIS_TAC []); 1001 1002val DISJOINT_DIFFS = store_thm (* from util_prob *) 1003 ("DISJOINT_DIFFS", 1004 ``!f g m n. 1005 (!n. f n SUBSET f (SUC n)) /\ 1006 (!n. g n = f (SUC n) DIFF f n) /\ ~(m = n) ==> 1007 DISJOINT (g m) (g n)``, 1008 RW_TAC std_ss [] 1009 >> Know `SUC m <= n \/ SUC n <= m` >- DECIDE_TAC 1010 >> REWRITE_TAC [LESS_EQ_EXISTS] 1011 >> STRIP_TAC >| 1012 [Know `f (SUC m) SUBSET f n` >- PROVE_TAC [SUBSET_ADD] 1013 >> RW_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, 1014 NOT_IN_EMPTY, IN_DIFF, SUBSET_DEF] 1015 >> PROVE_TAC [], 1016 Know `f (SUC n) SUBSET f m` >- PROVE_TAC [SUBSET_ADD] 1017 >> RW_TAC std_ss [DISJOINT_DEF, EXTENSION, IN_INTER, 1018 NOT_IN_EMPTY, IN_DIFF, SUBSET_DEF] 1019 >> PROVE_TAC []]); 1020 1021(* ===================================================================== *) 1022(* The insertion function. *) 1023(* ===================================================================== *) 1024 1025val INSERT_DEF = 1026 new_infixr_definition 1027 ("INSERT_DEF", (���INSERT (x:'a) s = {y | (y = x) \/ y IN s}���),490); 1028val _ = ot0 "INSERT" "insert" 1029 1030(* --------------------------------------------------------------------- *) 1031(* set up sets as a list-form the {x1;...;xn} notation *) 1032(* --------------------------------------------------------------------- *) 1033 1034val _ = add_listform {leftdelim = [TOK "{"], rightdelim = [TOK "}"], 1035 separator = [TOK ";", BreakSpace(1,0)], 1036 cons = "INSERT", nilstr = "EMPTY", 1037 block_info = (PP.INCONSISTENT, 1)}; 1038 1039(* --------------------------------------------------------------------- *) 1040(* Theorems about INSERT. *) 1041(* --------------------------------------------------------------------- *) 1042 1043Theorem IN_INSERT[simp]: 1044 !x:'a. !y s. x IN (y INSERT s) <=> x=y \/ x IN s 1045Proof 1046 PURE_ONCE_REWRITE_TAC [INSERT_DEF] THEN 1047 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN 1048 REPEAT GEN_TAC THEN REFL_TAC 1049QED 1050 1051Theorem COMPONENT: !x:'a. !s. x IN (x INSERT s) 1052Proof REWRITE_TAC [IN_INSERT] 1053QED 1054 1055val SET_CASES = store_thm("SET_CASES", 1056(���!s:'a set. 1057 (s = EMPTY) \/ 1058 ?x:'a. ?t. ((s = x INSERT t) /\ ~(x IN t))���), 1059 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY] THEN GEN_TAC THEN 1060 DISJ_CASES_THEN MP_TAC (SPEC (���?x:'a. x IN s���) EXCLUDED_MIDDLE) THENL 1061 [STRIP_TAC THEN DISJ2_TAC THEN 1062 MAP_EVERY EXISTS_TAC [���x:'a���, ���{y:'a | y IN s /\ ~(y = x)}���] THEN 1063 REWRITE_TAC [IN_INSERT] THEN 1064 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN 1065 ASM_REWRITE_TAC [] THEN 1066 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 1067 ASM_REWRITE_TAC[EXCLUDED_MIDDLE], 1068 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN 1069 STRIP_TAC THEN DISJ1_TAC THEN FIRST_ASSUM ACCEPT_TAC]); 1070 1071Theorem DECOMPOSITION: 1072 !s:'a set. !x. x IN s <=> ?t. s = x INSERT t /\ x NOTIN t 1073Proof 1074 REPEAT GEN_TAC THEN EQ_TAC THENL 1075 [DISCH_TAC THEN EXISTS_TAC (���{y:'a | y IN s /\ ~(y = x)}���) THEN 1076 ASM_REWRITE_TAC [EXTENSION,IN_INSERT] THEN 1077 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN 1078 REWRITE_TAC [] THEN 1079 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 1080 ASM_REWRITE_TAC [EXCLUDED_MIDDLE], 1081 STRIP_TAC THEN ASM_REWRITE_TAC [IN_INSERT]] 1082QED 1083 1084Theorem ABSORPTION: 1085 !x:'a. !s. (x IN s) <=> (x INSERT s = s) 1086Proof 1087 REWRITE_TAC [EXTENSION,IN_INSERT] THEN 1088 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 1089 ASM_REWRITE_TAC [] THEN 1090 FIRST_ASSUM (fn th => fn g => PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL th)] g) 1091 THEN DISJ1_TAC THEN REFL_TAC 1092QED 1093 1094val ABSORPTION_RWT = store_thm( 1095 "ABSORPTION_RWT", 1096 ``!x:'a s. x IN s ==> (x INSERT s = s)``, 1097 METIS_TAC [ABSORPTION]); 1098 1099val INSERT_INSERT = 1100 store_thm 1101 ("INSERT_INSERT", 1102 (���!x:'a. !s. x INSERT (x INSERT s) = x INSERT s���), 1103 REWRITE_TAC [IN_INSERT,EXTENSION] THEN 1104 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 1105 ASM_REWRITE_TAC[]); 1106 1107val INSERT_COMM = 1108 store_thm 1109 ("INSERT_COMM", 1110 (���!x:'a. !y s. x INSERT (y INSERT s) = y INSERT (x INSERT s)���), 1111 REWRITE_TAC [IN_INSERT,EXTENSION] THEN 1112 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 1113 ASM_REWRITE_TAC[]); 1114 1115val INSERT_UNIV = 1116 store_thm 1117 ("INSERT_UNIV", 1118 (���!x:'a. x INSERT UNIV = UNIV���), 1119 REWRITE_TAC [EXTENSION,IN_INSERT,IN_UNIV]); 1120 1121val NOT_INSERT_EMPTY = 1122 store_thm 1123 ("NOT_INSERT_EMPTY", 1124 (���!x:'a. !s. ~(x INSERT s = EMPTY)���), 1125 REWRITE_TAC [EXTENSION,IN_INSERT,NOT_IN_EMPTY,IN_UNION] THEN 1126 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 1127 REPEAT GEN_TAC THEN EXISTS_TAC (���x:'a���) THEN 1128 REWRITE_TAC []); 1129 1130val NOT_EMPTY_INSERT = 1131 store_thm 1132 ("NOT_EMPTY_INSERT", 1133 (���!x:'a. !s. ~(EMPTY = x INSERT s)���), 1134 REWRITE_TAC [EXTENSION,IN_INSERT,NOT_IN_EMPTY,IN_UNION] THEN 1135 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 1136 REPEAT GEN_TAC THEN EXISTS_TAC (���x:'a���) THEN 1137 REWRITE_TAC []); 1138 1139val _ = export_rewrites ["NOT_INSERT_EMPTY"]; 1140(* don't need both because simplifier's rewrite creator automatically gives 1141 both senses to inequalities *) 1142 1143val INSERT_UNION = store_thm ( 1144 "INSERT_UNION", 1145 (���!(x:'a) s t. 1146 (x INSERT s) UNION t = 1147 (if x IN t then s UNION t else x INSERT (s UNION t))���), 1148 REPEAT GEN_TAC THEN COND_CASES_TAC THEN 1149 ASM_REWRITE_TAC [EXTENSION,IN_UNION,IN_INSERT] THEN 1150 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC []); 1151 1152val INSERT_UNION_EQ = 1153 store_thm 1154 ("INSERT_UNION_EQ", 1155 (���!x:'a. !s t. (x INSERT s) UNION t = x INSERT (s UNION t)���), 1156 REPEAT GEN_TAC THEN 1157 REWRITE_TAC [EXTENSION,IN_UNION,IN_INSERT,DISJ_ASSOC]); 1158 1159val INSERT_INTER = 1160 store_thm 1161 ("INSERT_INTER", 1162 (���!x:'a. !s t. 1163 (x INSERT s) INTER t = 1164 (if x IN t then x INSERT (s INTER t) else s INTER t)���), 1165 REPEAT GEN_TAC THEN COND_CASES_TAC THEN 1166 ASM_REWRITE_TAC [EXTENSION,IN_INTER,IN_INSERT] THEN 1167 GEN_TAC THEN EQ_TAC THENL 1168 [STRIP_TAC THEN ASM_REWRITE_TAC [], 1169 STRIP_TAC THEN ASM_REWRITE_TAC [], 1170 PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN 1171 DISCH_THEN (CONJUNCTS_THEN MP_TAC) THEN 1172 STRIP_TAC THEN ASM_REWRITE_TAC [], 1173 STRIP_TAC THEN ASM_REWRITE_TAC []]); 1174 1175Theorem DISJOINT_INSERT[simp]: 1176 !(x:'a) s t. DISJOINT (x INSERT s) t <=> DISJOINT s t /\ x NOTIN t 1177Proof 1178 REWRITE_TAC [IN_DISJOINT,IN_INSERT] THEN 1179 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN 1180 REWRITE_TAC [DE_MORGAN_THM] THEN 1181 REPEAT GEN_TAC THEN EQ_TAC THENL 1182 [let val v = genvar (==`:'a`==) 1183 val GTAC = X_GEN_TAC v 1184 in DISCH_THEN (fn th => CONJ_TAC THENL [GTAC,ALL_TAC] THEN MP_TAC th) 1185 THENL [DISCH_THEN (STRIP_ASSUME_TAC o SPEC v) THEN ASM_REWRITE_TAC [], 1186 DISCH_THEN (MP_TAC o SPEC (���x:'a���)) THEN REWRITE_TAC[]] 1187 end, 1188 REPEAT STRIP_TAC THEN ASM_CASES_TAC (���x':'a = x���) THENL 1189 [ASM_REWRITE_TAC[], ASM_REWRITE_TAC[]]] 1190QED 1191 1192Theorem DISJOINT_INSERT'[simp] = 1193 ONCE_REWRITE_RULE [DISJOINT_SYM] DISJOINT_INSERT 1194 1195Theorem INSERT_SUBSET: 1196 !x:'a. !s t. (x INSERT s) SUBSET t <=> x IN t /\ s SUBSET t 1197Proof 1198 REWRITE_TAC [IN_INSERT,SUBSET_DEF] THEN 1199 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1200 [FIRST_ASSUM MATCH_MP_TAC THEN DISJ1_TAC THEN REFL_TAC, 1201 FIRST_ASSUM MATCH_MP_TAC THEN DISJ2_TAC THEN FIRST_ASSUM ACCEPT_TAC, 1202 ASM_REWRITE_TAC [], 1203 RES_TAC] 1204QED 1205 1206Theorem SUBSET_INSERT: 1207 !x:'a. !s. x NOTIN s ==> !t. s SUBSET (x INSERT t) <=> s SUBSET t 1208Proof 1209 PURE_REWRITE_TAC [SUBSET_DEF,IN_INSERT] THEN 1210 REPEAT STRIP_TAC THEN EQ_TAC THENL 1211 [REPEAT STRIP_TAC THEN 1212 let fun tac th g = SUBST_ALL_TAC th g 1213 handle _ => STRIP_ASSUME_TAC th g 1214 in RES_THEN (STRIP_THM_THEN tac) THEN RES_TAC 1215 end, 1216 REPEAT STRIP_TAC THEN DISJ2_TAC THEN 1217 FIRST_ASSUM MATCH_MP_TAC THEN 1218 FIRST_ASSUM ACCEPT_TAC] 1219QED 1220 1221val INSERT_DIFF = 1222 store_thm 1223 ("INSERT_DIFF", 1224 (���!s t. !x:'a. (x INSERT s) DIFF t = 1225 (if x IN t then s DIFF t else (x INSERT (s DIFF t)))���), 1226 REPEAT GEN_TAC THEN COND_CASES_TAC THENL 1227 [ASM_REWRITE_TAC [EXTENSION,IN_DIFF,IN_INSERT] THEN 1228 GEN_TAC THEN EQ_TAC THENL 1229 [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN 1230 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g) THEN RES_TAC, 1231 STRIP_TAC THEN ASM_REWRITE_TAC[]], 1232 ASM_REWRITE_TAC [EXTENSION,IN_DIFF,IN_INSERT] THEN 1233 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC [] THEN 1234 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g) THEN RES_TAC]); 1235 1236(* with INSERT to hand, it's easy to talk about concrete sets *) 1237val UNIV_BOOL = store_thm( 1238 "UNIV_BOOL", 1239 ``univ(:bool) = {T; F}``, 1240 SRW_TAC [][EXTENSION]); 1241val _ = export_rewrites ["UNIV_BOOL"] 1242 1243(* from probability/iterateTheory *) 1244val FORALL_IN_INSERT = store_thm 1245 ("FORALL_IN_INSERT", 1246 ``!P a s. (!x. x IN (a INSERT s) ==> P x) <=> P a /\ (!x. x IN s ==> P x)``, 1247 REWRITE_TAC [IN_INSERT] THEN PROVE_TAC []); 1248 1249val EXISTS_IN_INSERT = store_thm 1250 ("EXISTS_IN_INSERT", 1251 ``!P a s. (?x. x IN (a INSERT s) /\ P x) <=> P a \/ ?x. x IN s /\ P x``, 1252 REWRITE_TAC [IN_INSERT] THEN PROVE_TAC []); 1253 1254(* ===================================================================== *) 1255(* Removal of an element *) 1256(* ===================================================================== *) 1257 1258val DELETE_DEF = 1259 new_infixl_definition 1260 ("DELETE_DEF", (���DELETE s (x:'a) = s DIFF {x}���),500); 1261 1262Theorem IN_DELETE[simp]: 1263 !s. !x:'a. !y. x IN (s DELETE y) <=> x IN s /\ x <> y 1264Proof 1265 PURE_ONCE_REWRITE_TAC [DELETE_DEF] THEN 1266 REWRITE_TAC [IN_DIFF,IN_INSERT,NOT_IN_EMPTY] 1267QED 1268 1269Theorem DELETE_NON_ELEMENT: 1270 !x:'a. !s. x NOTIN s <=> (s DELETE x = s) 1271Proof 1272 PURE_REWRITE_TAC [EXTENSION,IN_DELETE] THEN 1273 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1274 [FIRST_ASSUM ACCEPT_TAC, 1275 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g handle _ => NO_TAC g) 1276 THEN RES_TAC, 1277 RES_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN REFL_TAC] 1278QED 1279 1280Theorem DELETE_NON_ELEMENT_RWT = 1281 DELETE_NON_ELEMENT |> SPEC_ALL |> EQ_IMP_RULE |> #1 1282 |> Q.GENL [`s`, `x`] 1283 1284Theorem IN_DELETE_EQ: 1285 !s x. !x':'a. 1286 (x IN s <=> x' IN s) <=> (x IN (s DELETE x') <=> x' IN (s DELETE x)) 1287Proof 1288 REPEAT GEN_TAC THEN ASM_CASES_TAC (���x:'a = x'���) THENL 1289 [ASM_REWRITE_TAC [], 1290 FIRST_ASSUM (ASSUME_TAC o NOT_EQ_SYM) THEN 1291 ASM_REWRITE_TAC [IN_DELETE]] 1292QED 1293 1294val EMPTY_DELETE = 1295 store_thm 1296 ("EMPTY_DELETE", 1297 (���!x:'a. EMPTY DELETE x = EMPTY���), 1298 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_DELETE]); 1299 1300val _ = export_rewrites ["EMPTY_DELETE"]; 1301 1302val ELT_IN_DELETE = store_thm 1303 ("ELT_IN_DELETE", 1304 ``!x s. ~(x IN (s DELETE x))``, 1305 RW_TAC std_ss [IN_DELETE]); 1306 1307val DELETE_DELETE = 1308 store_thm 1309 ("DELETE_DELETE", 1310 (���!x:'a. !s. (s DELETE x) DELETE x = s DELETE x���), 1311 REWRITE_TAC [EXTENSION,IN_DELETE,SYM(SPEC_ALL CONJ_ASSOC)]); 1312 1313val DELETE_COMM = 1314 store_thm 1315 ("DELETE_COMM", 1316 (���!x:'a. !y. !s. (s DELETE x) DELETE y = (s DELETE y) DELETE x���), 1317 PURE_REWRITE_TAC [EXTENSION,IN_DELETE,CONJ_ASSOC] THEN 1318 REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN 1319 REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC); 1320 1321val DELETE_SUBSET = 1322 store_thm 1323 ("DELETE_SUBSET", 1324 (���!x:'a. !s. (s DELETE x) SUBSET s���), 1325 PURE_REWRITE_TAC [SUBSET_DEF,IN_DELETE] THEN 1326 REPEAT STRIP_TAC); 1327 1328Theorem SUBSET_DELETE: 1329 !x:'a. !s t. s SUBSET (t DELETE x) <=> x NOTIN s /\ s SUBSET t 1330Proof 1331 REWRITE_TAC [SUBSET_DEF,IN_DELETE,EXTENSION] THEN 1332 REPEAT GEN_TAC THEN EQ_TAC THENL 1333 [REPEAT STRIP_TAC THENL 1334 [ASSUME_TAC (REFL (���x:'a���)) THEN RES_TAC, RES_TAC], 1335 REPEAT STRIP_TAC THENL 1336 [RES_TAC, FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g) THEN 1337 RES_TAC]] 1338QED 1339 1340Theorem SUBSET_INSERT_DELETE: 1341 !x:'a. !s t. s SUBSET (x INSERT t) <=> ((s DELETE x) SUBSET t) 1342Proof 1343 REPEAT GEN_TAC THEN 1344 REWRITE_TAC [SUBSET_DEF,IN_INSERT,IN_DELETE] THEN 1345 EQ_TAC THEN REPEAT STRIP_TAC THENL 1346 [RES_TAC THEN RES_TAC, 1347 ASM_CASES_TAC (���x':'a = x���) THEN 1348 ASM_REWRITE_TAC[] THEN RES_TAC] 1349QED 1350 1351val SUBSET_OF_INSERT = save_thm ("SUBSET_OF_INSERT", 1352 REWRITE_RULE [GSYM SUBSET_INSERT_DELETE] DELETE_SUBSET) ; 1353 1354val DIFF_INSERT = 1355 store_thm 1356 ("DIFF_INSERT", 1357 (���!s t. !x:'a. s DIFF (x INSERT t) = (s DELETE x) DIFF t���), 1358 PURE_REWRITE_TAC [EXTENSION,IN_DIFF,IN_INSERT,IN_DELETE] THEN 1359 REWRITE_TAC [DE_MORGAN_THM,CONJ_ASSOC]); 1360 1361Theorem PSUBSET_INSERT_SUBSET: 1362 !s t. s PSUBSET t <=> ?x:'a. x NOTIN s /\ (x INSERT s) SUBSET t 1363Proof 1364 PURE_REWRITE_TAC [PSUBSET_DEF,NOT_EQUAL_SETS] THEN 1365 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1366 [ASM_CASES_TAC (���(x:'a) IN s���) THENL 1367 [ASM_CASES_TAC (���(x:'a) IN t���) THENL 1368 [RES_TAC, IMP_RES_TAC SUBSET_DEF THEN RES_TAC], 1369 EXISTS_TAC (���x:'a���) THEN RES_TAC THEN 1370 ASM_REWRITE_TAC [INSERT_SUBSET]], 1371 IMP_RES_TAC INSERT_SUBSET, 1372 IMP_RES_TAC INSERT_SUBSET THEN 1373 EXISTS_TAC (���x:'a���) THEN ASM_REWRITE_TAC[]] 1374QED 1375 1376val lemma = 1377 TAC_PROOF(([], (���~(a:bool = b) = (b = ~a)���)), 1378 BOOL_CASES_TAC (���b:bool���) THEN REWRITE_TAC[]); 1379 1380Theorem PSUBSET_MEMBER: 1381 !s:'a set. !t. s PSUBSET t <=> s SUBSET t /\ ?y. y IN t /\ y NOTIN s 1382Proof 1383 REPEAT GEN_TAC THEN PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN 1384 PURE_ONCE_REWRITE_TAC [EXTENSION,SUBSET_DEF] THEN 1385 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 1386 PURE_ONCE_REWRITE_TAC [lemma] THEN 1387 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1388 [RES_TAC, 1389 EXISTS_TAC (���x:'a���) THEN ASM_REWRITE_TAC [] THEN 1390 ASM_CASES_TAC (���(x:'a) IN s���) THENL 1391 [RES_TAC THEN RES_TAC,FIRST_ASSUM ACCEPT_TAC], 1392 RES_TAC, 1393 EXISTS_TAC (���y:'a���) THEN ASM_REWRITE_TAC[]] 1394QED 1395 1396val DELETE_INSERT = store_thm("DELETE_INSERT", 1397(���!(x:'a) y s. 1398 (x INSERT s) DELETE y = (if (x=y) then s DELETE y 1399 else x INSERT (s DELETE y))���), 1400 REWRITE_TAC [EXTENSION,IN_DELETE,IN_INSERT] THEN 1401 REPEAT GEN_TAC THEN EQ_TAC THENL 1402 [DISCH_THEN (STRIP_THM_THEN MP_TAC) THEN DISCH_TAC THEN 1403 let fun tac th g = SUBST_ALL_TAC th g handle _ => ASSUME_TAC th g 1404 in DISCH_THEN (STRIP_THM_THEN tac) THENL 1405 [ASM_REWRITE_TAC [IN_INSERT], 1406 COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE,IN_INSERT]] 1407 end, 1408 COND_CASES_TAC THEN ASM_REWRITE_TAC [IN_DELETE,IN_INSERT] THENL 1409 [STRIP_TAC THEN ASM_REWRITE_TAC [], 1410 STRIP_TAC THEN ASM_REWRITE_TAC []]]); 1411 1412val INSERT_DELETE = 1413 store_thm 1414 ("INSERT_DELETE", 1415 (���!x:'a. !s. x IN s ==> (x INSERT (s DELETE x) = s)���), 1416 PURE_REWRITE_TAC [EXTENSION,IN_INSERT,IN_DELETE] THEN 1417 REPEAT GEN_TAC THEN DISCH_THEN (fn th => GEN_TAC THEN MP_TAC th) THEN 1418 ASM_CASES_TAC (���x':'a = x���) THEN ASM_REWRITE_TAC[]); 1419 1420(* --------------------------------------------------------------------- *) 1421(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *) 1422(* --------------------------------------------------------------------- *) 1423val DELETE_INTER = 1424 store_thm 1425 ("DELETE_INTER", 1426 (���!s t. !x:'a. (s DELETE x) INTER t = (s INTER t) DELETE x���), 1427 PURE_ONCE_REWRITE_TAC [EXTENSION] THEN REPEAT GEN_TAC THEN 1428 REWRITE_TAC [IN_INTER,IN_DELETE] THEN 1429 EQ_TAC THEN REPEAT STRIP_TAC THEN 1430 FIRST [FIRST_ASSUM ACCEPT_TAC,RES_TAC]); 1431 1432 1433(* --------------------------------------------------------------------- *) 1434(* A theorem from homeier@org.aero.uniblab (Peter Homeier) *) 1435(* --------------------------------------------------------------------- *) 1436val DISJOINT_DELETE_SYM = 1437 store_thm 1438 ("DISJOINT_DELETE_SYM", 1439 (���!s t. !x:'a. DISJOINT (s DELETE x) t = DISJOINT (t DELETE x) s���), 1440 REWRITE_TAC [DISJOINT_DEF,EXTENSION,NOT_IN_EMPTY] THEN 1441 REWRITE_TAC [IN_INTER,IN_DELETE,DE_MORGAN_THM] THEN 1442 REPEAT GEN_TAC THEN EQ_TAC THEN 1443 let val X = (���X:'a���) 1444 in DISCH_THEN (fn th => X_GEN_TAC X THEN STRIP_ASSUME_TAC (SPEC X th)) 1445 THEN ASM_REWRITE_TAC [] 1446 end); 1447 1448(* ===================================================================== *) 1449(* Choice *) 1450(* ===================================================================== *) 1451 1452val CHOICE_EXISTS = 1453 TAC_PROOF 1454 (([], (���?CHOICE. !s:'a set. ~(s = EMPTY) ==> (CHOICE s) IN s���)), 1455 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY] THEN 1456 EXISTS_TAC (���\s. @x:'a. x IN s���) THEN 1457 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN 1458 CONV_TAC (ONCE_DEPTH_CONV SELECT_CONV) THEN 1459 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 1460 REWRITE_TAC []); 1461 1462val CHOICE_DEF = new_specification("CHOICE_DEF",["CHOICE"],CHOICE_EXISTS); 1463val _ = ot0 "CHOICE" "choice" 1464 1465Theorem CHOICE_INTRO: 1466 (?x. x IN s) /\ (!x. x IN s ==> P x) ==> P (CHOICE s) 1467Proof 1468 rpt strip_tac >> first_x_assum irule >> 1469 METIS_TAC[CHOICE_DEF, MEMBER_NOT_EMPTY] 1470QED 1471 1472(* ===================================================================== *) 1473(* The REST of a set after removing a chosen element. *) 1474(* ===================================================================== *) 1475 1476val REST_DEF = 1477 new_definition 1478 ("REST_DEF", (���REST (s:'a set) = s DELETE (CHOICE s)���)); 1479 1480val IN_REST = store_thm 1481 ("IN_REST", 1482 ``!x:'a. !s. x IN (REST s) <=> x IN s /\ ~(x = CHOICE s)``, 1483 REWRITE_TAC [REST_DEF, IN_DELETE]); 1484 1485val CHOICE_NOT_IN_REST = 1486 store_thm 1487 ("CHOICE_NOT_IN_REST", 1488 (���!s:'a set. ~(CHOICE s IN REST s)���), 1489 REWRITE_TAC [IN_DELETE,REST_DEF]); 1490 1491val CHOICE_INSERT_REST = store_thm("CHOICE_INSERT_REST", 1492(���!s:'a set. ~(s = EMPTY) ==> ((CHOICE s) INSERT (REST s) = s)���), 1493 REPEAT GEN_TAC THEN STRIP_TAC THEN 1494 REWRITE_TAC [EXTENSION,IN_INSERT,REST_DEF,IN_DELETE] THEN 1495 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL 1496 [IMP_RES_TAC CHOICE_DEF THEN ASM_REWRITE_TAC [], 1497 ASM_REWRITE_TAC [EXCLUDED_MIDDLE]]); 1498 1499val REST_SUBSET = 1500 store_thm 1501 ("REST_SUBSET", 1502 (���!s:'a set. (REST s) SUBSET s���), 1503 REWRITE_TAC [SUBSET_DEF,REST_DEF,IN_DELETE] THEN REPEAT STRIP_TAC); 1504 1505val lemma = 1506 TAC_PROOF(([], (���(P /\ Q <=> P) <=> (P ==> Q)���)), 1507 BOOL_CASES_TAC (���P:bool���) THEN REWRITE_TAC[]); 1508 1509val REST_PSUBSET = 1510 store_thm 1511 ("REST_PSUBSET", 1512 (���!s:'a set. ~(s = EMPTY) ==> (REST s) PSUBSET s���), 1513 REWRITE_TAC [PSUBSET_DEF,REST_SUBSET] THEN 1514 GEN_TAC THEN STRIP_TAC THEN 1515 REWRITE_TAC [EXTENSION,REST_DEF,IN_DELETE] THEN 1516 CONV_TAC NOT_FORALL_CONV THEN 1517 REWRITE_TAC [DE_MORGAN_THM,lemma,NOT_IMP] THEN 1518 EXISTS_TAC (���CHOICE (s:'a set)���) THEN 1519 IMP_RES_TAC CHOICE_DEF THEN 1520 ASM_REWRITE_TAC []); 1521 1522(* ===================================================================== *) 1523(* Singleton set. *) 1524(* ===================================================================== *) 1525 1526val SING_DEF = 1527 new_definition 1528 ("SING_DEF", (���SING s = ?x:'a. s = {x}���)); 1529val _ = ot0 "SING" "singleton" 1530 1531val SING = 1532 store_thm 1533 ("SING", 1534 (���!x:'a. SING {x}���), 1535 PURE_ONCE_REWRITE_TAC [SING_DEF] THEN 1536 GEN_TAC THEN EXISTS_TAC (���x:'a���) THEN REFL_TAC); 1537val _ = export_rewrites ["SING"] 1538 1539val SING_EMPTY = store_thm( 1540 "SING_EMPTY", 1541 ``SING {} = F``, 1542 SRW_TAC [][SING_DEF]); 1543val _ = export_rewrites ["SING_EMPTY"] 1544 1545Theorem SING_INSERT[simp]: 1546 SING (x INSERT s) <=> (s = {}) \/ (s = {x}) 1547Proof 1548 SRW_TAC [][SimpLHS, SING_DEF, EXTENSION] THEN 1549 SRW_TAC [][EQ_IMP_THM, DISJ_IMP_THM, FORALL_AND_THM, EXTENSION] THEN 1550 METIS_TAC [] 1551QED 1552 1553Theorem SING_UNION: 1554 SING (s UNION t) <=> SING s /\ (t = {}) \/ SING t /\ (s = {}) \/ 1555 SING s /\ SING t /\ (s = t) 1556Proof 1557 SRW_TAC [][SING_DEF, EXTENSION, EQ_IMP_THM, FORALL_AND_THM, 1558 DISJ_IMP_THM] THEN METIS_TAC [] 1559QED 1560 1561Theorem IN_SING: 1562 !x y. x IN {y:'a} <=> (x = y) 1563Proof REWRITE_TAC [IN_INSERT,NOT_IN_EMPTY] 1564QED 1565 1566val NOT_SING_EMPTY = 1567 store_thm 1568 ("NOT_SING_EMPTY", 1569 (���!x:'a. ~({x} = EMPTY)���), 1570 REWRITE_TAC [EXTENSION,IN_SING,NOT_IN_EMPTY] THEN 1571 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 1572 GEN_TAC THEN EXISTS_TAC (���x:'a���) THEN REWRITE_TAC[]); 1573 1574val NOT_EMPTY_SING = 1575 store_thm 1576 ("NOT_EMPTY_SING", 1577 (���!x:'a. ~(EMPTY = {x})���), 1578 REWRITE_TAC [EXTENSION,IN_SING,NOT_IN_EMPTY] THEN 1579 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 1580 GEN_TAC THEN EXISTS_TAC (���x:'a���) THEN REWRITE_TAC[]); 1581 1582val EQUAL_SING = 1583 store_thm 1584 ("EQUAL_SING", 1585 (���!x:'a. !y. ({x} = {y}) = (x = y)���), 1586 REWRITE_TAC [EXTENSION,IN_SING] THEN 1587 REPEAT GEN_TAC THEN EQ_TAC THENL 1588 [DISCH_THEN (fn th => REWRITE_TAC [SYM(SPEC_ALL th)]), 1589 DISCH_THEN SUBST1_TAC THEN GEN_TAC THEN REFL_TAC]); 1590val _ = export_rewrites ["EQUAL_SING"] 1591 1592val DISJOINT_SING_EMPTY = 1593 store_thm 1594 ("DISJOINT_SING_EMPTY", 1595 (���!x:'a. DISJOINT {x} EMPTY���), 1596 REWRITE_TAC [DISJOINT_DEF,INTER_EMPTY]); 1597 1598val INSERT_SING_UNION = 1599 store_thm 1600 ("INSERT_SING_UNION", 1601 (���!s. !x:'a. x INSERT s = {x} UNION s���), 1602 REWRITE_TAC [EXTENSION,IN_INSERT,IN_UNION,NOT_IN_EMPTY]); 1603 1604val SING_DELETE = 1605 store_thm 1606 ("SING_DELETE", 1607 (���!x:'a. {x} DELETE x = EMPTY���), 1608 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_DELETE,IN_INSERT] THEN 1609 PURE_ONCE_REWRITE_TAC [CONJ_SYM] THEN 1610 REWRITE_TAC [DE_MORGAN_THM,EXCLUDED_MIDDLE]); 1611val _ = export_rewrites ["SING_DELETE"] 1612 1613val DELETE_EQ_SING = 1614 store_thm 1615 ("DELETE_EQ_SING", 1616 (���!s. !x:'a. (x IN s) ==> ((s DELETE x = EMPTY) = (s = {x}))���), 1617 PURE_ONCE_REWRITE_TAC [EXTENSION] THEN 1618 REWRITE_TAC [NOT_IN_EMPTY,DE_MORGAN_THM,IN_INSERT,IN_DELETE] THEN 1619 REPEAT STRIP_TAC THEN EQ_TAC THENL 1620 [DISCH_TAC THEN GEN_TAC THEN 1621 FIRST_ASSUM (fn th=>fn g => STRIP_ASSUME_TAC (SPEC (���x':'a���) th) g) 1622 THEN ASM_REWRITE_TAC [] THEN DISCH_THEN SUBST_ALL_TAC THEN RES_TAC, 1623 let val th = PURE_ONCE_REWRITE_RULE [DISJ_SYM] EXCLUDED_MIDDLE 1624 in DISCH_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC [th] 1625 end]); 1626 1627val CHOICE_SING = 1628 store_thm 1629 ("CHOICE_SING", 1630 (���!x:'a. CHOICE {x} = x���), 1631 GEN_TAC THEN 1632 MP_TAC (MATCH_MP CHOICE_DEF (SPEC (���x:'a���) NOT_SING_EMPTY)) THEN 1633 REWRITE_TAC [IN_SING]); 1634val _ = export_rewrites ["CHOICE_SING"] 1635 1636val REST_SING = 1637 store_thm 1638 ("REST_SING", 1639 (���!x:'a. REST {x} = EMPTY���), 1640 REWRITE_TAC [CHOICE_SING,REST_DEF,SING_DELETE]); 1641val _ = export_rewrites ["REST_SING"] 1642 1643Theorem SING_IFF_EMPTY_REST: 1644 !s:'a set. SING s <=> s <> EMPTY /\ REST s = EMPTY 1645Proof 1646 PURE_ONCE_REWRITE_TAC [SING_DEF] THEN 1647 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL 1648 [ASM_REWRITE_TAC [REST_SING] THEN 1649 REWRITE_TAC [EXTENSION,NOT_IN_EMPTY,IN_INSERT] THEN 1650 CONV_TAC NOT_FORALL_CONV THEN 1651 EXISTS_TAC (���x:'a���) THEN REWRITE_TAC [], 1652 EXISTS_TAC (���CHOICE s:'a���) THEN 1653 IMP_RES_THEN (SUBST1_TAC o SYM) CHOICE_INSERT_REST THEN 1654 ASM_REWRITE_TAC [EXTENSION,IN_SING,CHOICE_SING]] 1655QED 1656 1657 1658 1659(* ===================================================================== *) 1660(* The image of a function on a set. *) 1661(* ===================================================================== *) 1662 1663val IMAGE_DEF = 1664 new_definition 1665 ("IMAGE_DEF", (���IMAGE (f:'a->'b) s = {f x | x IN s}���)); 1666 1667val _ = ot0 "IMAGE" "image" 1668 1669Theorem IN_IMAGE[simp]: 1670 !y:'b. !s f. y IN (IMAGE f s) <=> ?x:'a. y = f x /\ x IN s 1671Proof 1672 PURE_ONCE_REWRITE_TAC [IMAGE_DEF] THEN 1673 CONV_TAC (ONCE_DEPTH_CONV SET_SPEC_CONV) THEN 1674 REPEAT GEN_TAC THEN REFL_TAC 1675QED 1676 1677val IMAGE_IN = 1678 store_thm 1679 ("IMAGE_IN", 1680 (���!x s. (x IN s) ==> !(f:'a->'b). f x IN (IMAGE f s)���), 1681 PURE_ONCE_REWRITE_TAC [IN_IMAGE] THEN 1682 REPEAT STRIP_TAC THEN 1683 EXISTS_TAC (���x:'a���) THEN 1684 CONJ_TAC THENL [REFL_TAC, FIRST_ASSUM ACCEPT_TAC]); 1685 1686val IMAGE_EMPTY = 1687 store_thm 1688 ("IMAGE_EMPTY", 1689 (���!f:'a->'b. IMAGE f EMPTY = EMPTY���), 1690 REWRITE_TAC[EXTENSION,IN_IMAGE,NOT_IN_EMPTY]); 1691val _ = export_rewrites ["IMAGE_EMPTY"] 1692 1693val IMAGE_ID = 1694 store_thm 1695 ("IMAGE_ID", 1696 (���!s:'a set. IMAGE (\x:'a.x) s = s���), 1697 REWRITE_TAC [EXTENSION,IN_IMAGE] THEN 1698 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN 1699 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1700 [ALL_TAC,EXISTS_TAC (���x:'a���)] THEN 1701 ASM_REWRITE_TAC []); 1702 1703val IMAGE_I = store_thm("IMAGE_I[simp]", 1704 ``IMAGE I s = s``, 1705 full_simp_tac(srw_ss())[EXTENSION]); 1706 1707val IMAGE_II = store_thm (* from util_prob *) 1708 ("IMAGE_II", 1709 ``IMAGE I = I``, 1710 RW_TAC std_ss [FUN_EQ_THM] 1711 >> METIS_TAC [SPECIFICATION, IN_IMAGE, combinTheory.I_THM]); 1712 1713val o_THM = combinTheory.o_THM; 1714 1715val IMAGE_COMPOSE = 1716 store_thm 1717 ("IMAGE_COMPOSE", 1718 (���!f:'b->'c. !g:'a->'b. !s. IMAGE (f o g) s = IMAGE f (IMAGE g s)���), 1719 PURE_REWRITE_TAC [EXTENSION,IN_IMAGE,o_THM] THEN 1720 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1721 [EXISTS_TAC (���g (x':'a):'b���) THEN 1722 CONJ_TAC THENL [ALL_TAC,EXISTS_TAC (���x':'a���)] THEN 1723 ASM_REWRITE_TAC [], 1724 EXISTS_TAC (���x'':'a���) THEN ASM_REWRITE_TAC[]]); 1725 1726val IMAGE_INSERT = 1727 store_thm 1728 ("IMAGE_INSERT", 1729 (���!(f:'a->'b) x s. IMAGE f (x INSERT s) = f x INSERT (IMAGE f s)���), 1730 PURE_REWRITE_TAC [EXTENSION,IN_INSERT,IN_IMAGE] THEN 1731 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1732 [ALL_TAC,DISJ2_TAC THEN EXISTS_TAC (���x'':'a���), 1733 EXISTS_TAC (���x:'a���),EXISTS_TAC (���x'':'a���)] THEN 1734 ASM_REWRITE_TAC[]); 1735val _ = export_rewrites ["IMAGE_INSERT"] 1736 1737Theorem IMAGE_EQ_EMPTY[simp]: 1738 !s (f:'a->'b). (IMAGE f s = {} <=> s = {}) /\ ({} = IMAGE f s <=> s = {}) 1739Proof 1740 GEN_TAC THEN 1741 STRIP_ASSUME_TAC (SPEC (���s:'a set���) SET_CASES) THEN 1742 ASM_REWRITE_TAC [IMAGE_EMPTY,IMAGE_INSERT,NOT_INSERT_EMPTY, NOT_EMPTY_INSERT] 1743QED 1744 1745val IMAGE_DELETE = store_thm("IMAGE_DELETE", 1746(���!(f:'a->'b) x s. ~(x IN s) ==> (IMAGE f (s DELETE x) = (IMAGE f s))���), 1747 REPEAT GEN_TAC THEN STRIP_TAC THEN 1748 PURE_REWRITE_TAC [EXTENSION,IN_DELETE,IN_IMAGE] THEN 1749 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN 1750 EXISTS_TAC (���x'':'a���) THEN ASM_REWRITE_TAC [] THEN 1751 DISCH_THEN SUBST_ALL_TAC THEN RES_TAC); 1752 1753val IMAGE_UNION = store_thm("IMAGE_UNION", 1754(���!(f:'a->'b) s t. IMAGE f (s UNION t) = (IMAGE f s) UNION (IMAGE f t)���), 1755 PURE_REWRITE_TAC [EXTENSION,IN_UNION,IN_IMAGE] THEN 1756 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1757 [DISJ1_TAC,DISJ2_TAC,ALL_TAC,ALL_TAC] THEN 1758 EXISTS_TAC (���x':'a���) THEN ASM_REWRITE_TAC []); 1759 1760val IMAGE_SUBSET = 1761 store_thm 1762 ("IMAGE_SUBSET", 1763 (���!s t. (s SUBSET t) ==> !f:'a->'b. (IMAGE f s) SUBSET (IMAGE f t)���), 1764 PURE_REWRITE_TAC [SUBSET_DEF,IN_IMAGE] THEN 1765 REPEAT STRIP_TAC THEN RES_TAC THEN 1766 EXISTS_TAC (���x':'a���) THEN ASM_REWRITE_TAC []); 1767 1768val IMAGE_INTER = store_thm ("IMAGE_INTER", 1769���!(f:'a->'b) s t. IMAGE f (s INTER t) SUBSET (IMAGE f s INTER IMAGE f t)���, 1770 REPEAT GEN_TAC THEN 1771 REWRITE_TAC [SUBSET_DEF,IN_IMAGE,IN_INTER] THEN 1772 REPEAT STRIP_TAC THEN 1773 EXISTS_TAC (���x':'a���) THEN 1774 CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC); 1775 1776val IMAGE_11 = store_thm( 1777 "IMAGE_11", 1778 ``(!x y. (f x = f y) <=> (x = y)) ==> 1779 ((IMAGE f s1 = IMAGE f s2) <=> (s1 = s2))``, 1780 STRIP_TAC THEN SIMP_TAC (srw_ss()) [EQ_IMP_THM] THEN 1781 SRW_TAC [boolSimps.DNF_ss][EXTENSION, EQ_IMP_THM]); 1782 1783val DISJOINT_IMAGE = Q.store_thm( 1784 "DISJOINT_IMAGE", 1785 ���(!x y. (f x = f y) <=> (x = y)) ==> 1786 (DISJOINT (IMAGE f s1) (IMAGE f s2) <=> DISJOINT s1 s2)���, 1787 simp[DISJOINT_DEF, EQ_IMP_THM, EXTENSION] >> METIS_TAC[]); 1788 1789val IMAGE_CONG = store_thm( 1790"IMAGE_CONG", 1791``!f s f' s'. (s = s') /\ (!x. x IN s' ==> (f x = f' x)) 1792==> (IMAGE f s = IMAGE f' s')``, 1793SRW_TAC[][EXTENSION] THEN METIS_TAC[]) 1794val _ = DefnBase.export_cong"IMAGE_CONG" 1795 1796val GSPEC_IMAGE = Q.store_thm ("GSPEC_IMAGE", 1797 `GSPEC f = IMAGE (FST o f) (SND o f)`, 1798 REWRITE_TAC [EXTENSION, IN_IMAGE, GSPECIFICATION] THEN 1799 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN 1800 Q.EXISTS_TAC `x'` THEN Cases_on `f x'` THEN 1801 FULL_SIMP_TAC bool_ss [EXTENSION, SPECIFICATION, 1802 combinTheory.o_THM, FST, SND, PAIR_EQ]) ; 1803 1804val IMAGE_IMAGE = store_thm 1805 ("IMAGE_IMAGE", 1806 ``!f g s. IMAGE f (IMAGE g s) = IMAGE (f o g) s``, 1807 RW_TAC std_ss [EXTENSION, IN_IMAGE, o_THM] 1808 >> PROVE_TAC []); 1809 1810val FORALL_IN_IMAGE = store_thm (* from iterateTheory *) 1811 ("FORALL_IN_IMAGE", 1812 ``!P f s. (!y. y IN IMAGE f s ==> P y) <=> (!x. x IN s ==> P(f x))``, 1813 REWRITE_TAC [IN_IMAGE] THEN PROVE_TAC []); 1814 1815val EXISTS_IN_IMAGE = store_thm (* from real_topologyTheory *) 1816 ("EXISTS_IN_IMAGE", 1817 ``!P f s. (?y. y IN IMAGE f s /\ P y) <=> ?x. x IN s /\ P(f x)``, 1818 REWRITE_TAC [IN_IMAGE] THEN PROVE_TAC []); 1819 1820val IMAGE_SING = store_thm (* from measureTheory *) 1821 ("IMAGE_SING", ``!f x. IMAGE f {x} = {f x}``, 1822 RW_TAC std_ss [EXTENSION,IN_SING,IN_IMAGE] >> METIS_TAC []); 1823val _ = export_rewrites ["IMAGE_SING"]; 1824 1825Theorem SUBSET_IMAGE : (* from topologyTheory *) 1826 !f:'a->'b s t. s SUBSET (IMAGE f t) <=> ?u. u SUBSET t /\ (s = IMAGE f u) 1827Proof 1828 REPEAT GEN_TAC THEN EQ_TAC THENL [ALL_TAC, MESON_TAC[IMAGE_SUBSET]] THEN 1829 DISCH_TAC THEN EXISTS_TAC ``{x | x IN t /\ (f:'a->'b) x IN s}`` THEN 1830 POP_ASSUM MP_TAC THEN 1831 SIMP_TAC std_ss [EXTENSION, SUBSET_DEF, IN_IMAGE, GSPECIFICATION] THEN 1832 MESON_TAC[] 1833QED 1834 1835(* ===================================================================== *) 1836(* Injective functions on a set. *) 1837(* ===================================================================== *) 1838 1839val INJ_DEF = 1840 new_definition 1841 ("INJ_DEF", 1842 (���INJ (f:'a->'b) s t <=> 1843 (!x. x IN s ==> (f x) IN t) /\ 1844 (!x y. (x IN s /\ y IN s) ==> (f x = f y) ==> (x = y))���)); 1845 1846val INJ_IFF = store_thm( 1847 "INJ_IFF", 1848 ``INJ (f:'a -> 'b) s t <=> 1849 (!x. x IN s ==> f x IN t) /\ 1850 (!x y. x IN s /\ y IN s ==> ((f x = f y) <=> (x = y)))``, 1851 METIS_TAC[INJ_DEF]); 1852 1853val INJ_ID = 1854 store_thm 1855 ("INJ_ID", 1856 (���!s. INJ (\x:'a.x) s s���), 1857 PURE_ONCE_REWRITE_TAC [INJ_DEF] THEN 1858 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN 1859 REPEAT STRIP_TAC); 1860 1861val INJ_COMPOSE = 1862 store_thm 1863 ("INJ_COMPOSE", 1864 (���!f:'a->'b. !g:'b->'c. 1865 !s t u. (INJ f s t /\ INJ g t u) ==> INJ (g o f) s u���), 1866 PURE_REWRITE_TAC [INJ_DEF,o_THM] THEN 1867 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1868 [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC, 1869 RES_TAC THEN RES_TAC]); 1870 1871val INJ_EMPTY = 1872 store_thm 1873 ("INJ_EMPTY[simp]", 1874 (���!f:'a->'b. (!s. INJ f {} s) /\ (!s. INJ f s {} = (s = {}))���), 1875 REWRITE_TAC [INJ_DEF,NOT_IN_EMPTY,EXTENSION] THEN 1876 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN RES_TAC); 1877 1878val INJ_DELETE = Q.store_thm 1879 ("INJ_DELETE", 1880 `!f s t. INJ f s t ==> !e. e IN s ==> INJ f (s DELETE e) (t DELETE (f e))`, 1881 RW_TAC bool_ss [INJ_DEF, DELETE_DEF] THENL 1882 [`~(e = x)` by FULL_SIMP_TAC bool_ss 1883 [DIFF_DEF,DIFF_INSERT, DIFF_EMPTY, IN_DELETE] THEN 1884 FULL_SIMP_TAC bool_ss [DIFF_DEF,DIFF_INSERT, DIFF_EMPTY, IN_DELETE] THEN 1885 METIS_TAC [], 1886 METIS_TAC [IN_DIFF]]); 1887 1888Theorem INJ_INSERT: 1889 !f x s t. INJ f (x INSERT s) t <=> 1890 INJ f s t /\ (f x) IN t /\ 1891 (!y. y IN s /\ (f x = f y) ==> (x = y)) 1892Proof 1893 SRW_TAC[][INJ_DEF] THEN METIS_TAC[] 1894QED 1895 1896val INJ_EXTEND = Q.store_thm( 1897 "INJ_EXTEND", 1898 `!b s t x y. 1899 INJ b s t /\ x NOTIN s /\ y NOTIN t ==> 1900 INJ ((x =+ y) b) (x INSERT s) (y INSERT t)`, 1901 rpt GEN_TAC \\ 1902 fs[INJ_DEF,combinTheory.APPLY_UPDATE_THM] >> METIS_TAC []); 1903 1904val INJ_SUBSET = store_thm( 1905"INJ_SUBSET", 1906``!f s t s0 t0. INJ f s t /\ s0 SUBSET s /\ t SUBSET t0 ==> INJ f s0 t0``, 1907SRW_TAC[][INJ_DEF,SUBSET_DEF]) 1908 1909val INJ_IMAGE = Q.store_thm ("INJ_IMAGE", 1910 `!f s t. INJ f s t ==> INJ f s (IMAGE f s)`, 1911 REPEAT GEN_TAC THEN 1912 REWRITE_TAC [INJ_DEF, IN_IMAGE] THEN 1913 REPEAT DISCH_TAC THEN ASM_REWRITE_TAC [] THEN 1914 REPEAT STRIP_TAC THEN Q.EXISTS_TAC `x` THEN ASM_REWRITE_TAC []); 1915 1916val INJ_IMAGE_SUBSET = Q.store_thm ("INJ_IMAGE_SUBSET", 1917 `!f s t. INJ f s t ==> IMAGE f s SUBSET t`, 1918 REPEAT GEN_TAC THEN 1919 REWRITE_TAC [INJ_DEF, SUBSET_DEF, IN_IMAGE] THEN 1920 REPEAT STRIP_TAC THEN BasicProvers.VAR_EQ_TAC THEN RES_TAC); 1921 1922(* ===================================================================== *) 1923(* Surjective functions on a set. *) 1924(* ===================================================================== *) 1925 1926val SURJ_DEF = 1927 new_definition 1928 ("SURJ_DEF", 1929 (���SURJ (f:'a->'b) s t <=> 1930 (!x. x IN s ==> (f x) IN t) /\ 1931 (!x. (x IN t) ==> ?y. y IN s /\ (f y = x))���)); 1932 1933val SURJ_ID = 1934 store_thm 1935 ("SURJ_ID", 1936 (���!s. SURJ (\x:'a.x) s s���), 1937 PURE_ONCE_REWRITE_TAC [SURJ_DEF] THEN 1938 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN 1939 REPEAT STRIP_TAC THEN 1940 EXISTS_TAC (���x:'a���) THEN 1941 ASM_REWRITE_TAC []); 1942 1943val SURJ_COMPOSE = 1944 store_thm 1945 ("SURJ_COMPOSE", 1946 (���!f:'a->'b. !g:'b->'c. 1947 !s t u. (SURJ f s t /\ SURJ g t u) ==> SURJ (g o f) s u���), 1948 PURE_REWRITE_TAC [SURJ_DEF,o_THM] THEN 1949 REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1950 [FIRST_ASSUM MATCH_MP_TAC THEN RES_TAC, 1951 RES_TAC THEN RES_TAC THEN 1952 EXISTS_TAC (���y'':'a���) THEN 1953 ASM_REWRITE_TAC []]); 1954 1955val SURJ_EMPTY = store_thm ("SURJ_EMPTY", 1956���!f:'a->'b. (!s. SURJ f {} s = (s = {})) /\ (!s. SURJ f s {} = (s = {}))���, 1957 REWRITE_TAC [SURJ_DEF,NOT_IN_EMPTY,EXTENSION]); 1958 1959val IMAGE_SURJ = 1960 store_thm 1961 ("IMAGE_SURJ", 1962 (���!f:'a->'b. !s t. SURJ f s t = ((IMAGE f s) = t)���), 1963 PURE_REWRITE_TAC [SURJ_DEF,EXTENSION,IN_IMAGE] THEN 1964 REPEAT GEN_TAC THEN EQ_TAC THENL 1965 [REPEAT (STRIP_TAC ORELSE EQ_TAC) THENL 1966 [RES_TAC THEN ASM_REWRITE_TAC [], 1967 MAP_EVERY PURE_ONCE_REWRITE_TAC [[CONJ_SYM],[EQ_SYM_EQ]] THEN 1968 FIRST_ASSUM MATCH_MP_TAC THEN FIRST_ASSUM ACCEPT_TAC], 1969 DISCH_THEN (ASSUME_TAC o CONV_RULE (ONCE_DEPTH_CONV SYM_CONV)) THEN 1970 ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THENL 1971 [EXISTS_TAC (���x:'a���) THEN ASM_REWRITE_TAC [], 1972 EXISTS_TAC (���x':'a���) THEN ASM_REWRITE_TAC []]]); 1973 1974val SURJ_IMAGE = store_thm( 1975 "SURJ_IMAGE", 1976 ``SURJ f s (IMAGE f s)``, 1977 REWRITE_TAC[IMAGE_SURJ]); 1978val _ = export_rewrites ["SURJ_IMAGE"] 1979 1980val SURJ_IMP_INJ = store_thm (* from util_prob *) 1981 ("SURJ_IMP_INJ", 1982 ``!s t. (?f. SURJ f s t) ==> (?g. INJ g t s)``, 1983 RW_TAC std_ss [SURJ_DEF, INJ_DEF] 1984 >> Suff `?g. !x. x IN t ==> g x IN s /\ (f (g x) = x)` 1985 >- PROVE_TAC [] 1986 >> Q.EXISTS_TAC `\y. @x. x IN s /\ (f x = y)` 1987 >> POP_ASSUM MP_TAC 1988 >> RW_TAC std_ss [boolTheory.EXISTS_DEF]); 1989 1990(* ===================================================================== *) 1991(* Bijective functions on a set. *) 1992(* ===================================================================== *) 1993 1994val BIJ_DEF = 1995 new_definition 1996 ("BIJ_DEF", 1997 (���BIJ (f:'a->'b) s t <=> INJ f s t /\ SURJ f s t���)); 1998 1999val BIJ_ID = 2000 store_thm 2001 ("BIJ_ID", 2002 (���!s. BIJ (\x:'a.x) s s���), 2003 REWRITE_TAC [BIJ_DEF,INJ_ID,SURJ_ID]); 2004 2005val BIJ_IMP_11 = Q.store_thm("BIJ_IMP_11", 2006 `BIJ f UNIV UNIV ==> !x y. (f x = f y) = (x = y)`, 2007 FULL_SIMP_TAC (srw_ss())[BIJ_DEF,INJ_DEF] \\ METIS_TAC []); 2008 2009val BIJ_EMPTY = store_thm("BIJ_EMPTY", 2010(���!f:'a->'b. (!s. BIJ f {} s = (s = {})) /\ (!s. BIJ f s {} = (s = {}))���), 2011 REWRITE_TAC [BIJ_DEF,INJ_EMPTY,SURJ_EMPTY]); 2012val _ = export_rewrites ["BIJ_EMPTY"] 2013 2014val BIJ_COMPOSE = 2015 store_thm 2016 ("BIJ_COMPOSE", 2017 (���!f:'a->'b. !g:'b->'c. 2018 !s t u. (BIJ f s t /\ BIJ g t u) ==> BIJ (g o f) s u���), 2019 PURE_REWRITE_TAC [BIJ_DEF] THEN 2020 REPEAT STRIP_TAC THENL 2021 [IMP_RES_TAC INJ_COMPOSE,IMP_RES_TAC SURJ_COMPOSE]); 2022 2023val BIJ_DELETE = Q.store_thm 2024("BIJ_DELETE", 2025 `!s t f. BIJ f s t ==> !e. e IN s ==> BIJ f (s DELETE e) (t DELETE (f e))`, 2026RW_TAC bool_ss [BIJ_DEF, SURJ_DEF, INJ_DELETE, DELETE_DEF, INJ_DEF] THENL 2027[FULL_SIMP_TAC bool_ss [DIFF_DEF,DIFF_INSERT, DIFF_EMPTY, IN_DELETE] THEN 2028 METIS_TAC [], 2029 `?y. y IN s /\ (f y = x)` by METIS_TAC [IN_DIFF] THEN 2030 Q.EXISTS_TAC `y` THEN RW_TAC bool_ss [] THEN 2031 `~(y = e)` by (FULL_SIMP_TAC bool_ss [DIFF_DEF, DIFF_INSERT, DIFF_EMPTY, 2032 IN_DELETE] THEN 2033 METIS_TAC [IN_DIFF]) THEN 2034 FULL_SIMP_TAC bool_ss [DIFF_DEF, DIFF_INSERT, DIFF_EMPTY, IN_DELETE]]); 2035 2036val INJ_IMAGE_BIJ = store_thm (* from util_prob *) 2037 ("INJ_IMAGE_BIJ", 2038 ``!s f. (?t. INJ f s t) ==> BIJ f s (IMAGE f s)``, 2039 RW_TAC std_ss [INJ_DEF, BIJ_DEF, SURJ_DEF, IN_IMAGE] 2040 >> PROVE_TAC []); 2041 2042val INJ_BIJ_SUBSET = store_thm (* from cardinalTheory *) 2043 ("INJ_BIJ_SUBSET", 2044 ``s0 SUBSET s /\ INJ f s t ==> BIJ f s0 (IMAGE f s0)``, 2045 SIMP_TAC std_ss [SUBSET_DEF, INJ_DEF, IMAGE_SURJ, BIJ_DEF, IN_IMAGE] 2046 >> METIS_TAC []); 2047 2048val BIJ_SYM_IMP = store_thm (* from util_prob *) 2049 ("BIJ_SYM_IMP", 2050 ``!s t. (?f. BIJ f s t) ==> (?g. BIJ g t s)``, 2051 RW_TAC std_ss [BIJ_DEF, SURJ_DEF, INJ_DEF] 2052 >> Suff `?(g : 'b -> 'a). !x. x IN t ==> g x IN s /\ (f (g x) = x)` 2053 >- (rpt STRIP_TAC 2054 >> Q.EXISTS_TAC `g` 2055 >> RW_TAC std_ss [] 2056 >> PROVE_TAC []) 2057 >> POP_ASSUM (MP_TAC o ONCE_REWRITE_RULE [boolTheory.EXISTS_DEF]) 2058 >> RW_TAC std_ss [] 2059 >> Q.EXISTS_TAC `\x. @y. y IN s /\ (f y = x)` 2060 >> RW_TAC std_ss []); 2061 2062val BIJ_SYM = store_thm (* from util_prob *) 2063 ("BIJ_SYM", 2064 ``!s t. (?f. BIJ f s t) = (?g. BIJ g t s)``, 2065 PROVE_TAC [BIJ_SYM_IMP]); 2066 2067val BIJ_TRANS = store_thm (* from util_prob *) 2068 ("BIJ_TRANS", 2069 ``!s t u. 2070 (?f. BIJ f s t) /\ (?g. BIJ g t u) ==> (?h : 'a -> 'b. BIJ h s u)``, 2071 RW_TAC std_ss [] 2072 >> Q.EXISTS_TAC `g o f` 2073 >> PROVE_TAC [BIJ_COMPOSE]); 2074 2075val BIJ_INV = store_thm 2076 ("BIJ_INV", ``!f s t. BIJ f s t ==> 2077 ?g. 2078 BIJ g t s /\ 2079 (!x. x IN s ==> ((g o f) x = x)) /\ 2080 (!x. x IN t ==> ((f o g) x = x))``, 2081 RW_TAC std_ss [] 2082 >> FULL_SIMP_TAC std_ss [BIJ_DEF, INJ_DEF, SURJ_DEF, combinTheory.o_THM] 2083 >> POP_ASSUM 2084 (MP_TAC o 2085 CONV_RULE 2086 (DEPTH_CONV RIGHT_IMP_EXISTS_CONV 2087 THENC SKOLEM_CONV 2088 THENC REWRITE_CONV [EXISTS_DEF] 2089 THENC DEPTH_CONV BETA_CONV)) 2090 >> Q.SPEC_TAC (`@y. !x. x IN t ==> y x IN s /\ (f (y x) = x)`, `g`) 2091 >> RW_TAC std_ss [] 2092 >> Q.EXISTS_TAC `g` 2093 >> RW_TAC std_ss [] 2094 >> PROVE_TAC []); 2095 2096 2097 2098 2099(* ===================================================================== *) 2100(* Fun set and Schroeder Bernstein Theorems (from util_probTheory) *) 2101(* ===================================================================== *) 2102 2103(* f:P->Q := f IN (FUNSET P Q) *) 2104val FUNSET = new_definition ("FUNSET", 2105 ``FUNSET (P :'a -> bool) (Q :'b -> bool) = \f. !x. x IN P ==> f x IN Q``); 2106 2107val DFUNSET = new_definition ("DFUNSET", 2108 ``DFUNSET (P :'a -> bool) (Q :'a -> 'b -> bool) = 2109 \f. !x. x IN P ==> f x IN Q x``); 2110 2111Theorem IN_FUNSET: 2112 !(f :'a -> 'b) P Q. f IN (FUNSET P Q) <=> !x. x IN P ==> f x IN Q 2113Proof RW_TAC std_ss [SPECIFICATION, FUNSET] 2114QED 2115 2116Theorem IN_DFUNSET: 2117 !(f :'a -> 'b) (P :'a -> bool) Q. 2118 f IN (DFUNSET P Q) <=> !x. x IN P ==> f x IN Q x 2119Proof RW_TAC std_ss [SPECIFICATION, DFUNSET] 2120QED 2121 2122val FUNSET_THM = store_thm 2123 ("FUNSET_THM", ``!s t (f :'a -> 'b) x. f IN (FUNSET s t) /\ x IN s ==> f x IN t``, 2124 RW_TAC std_ss [IN_FUNSET] >> PROVE_TAC []); 2125 2126val UNIV_FUNSET_UNIV = store_thm 2127 ("UNIV_FUNSET_UNIV", ``FUNSET (UNIV :'a -> bool) (UNIV :'b -> bool) = UNIV``, 2128 RW_TAC std_ss [EXTENSION, IN_UNIV, IN_FUNSET]); 2129 2130val FUNSET_DFUNSET = store_thm 2131 ("FUNSET_DFUNSET", ``!(x :'a -> bool) (y :'b -> bool). FUNSET x y = DFUNSET x (K y)``, 2132 RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_FUNSET, IN_DFUNSET, K_DEF]); 2133 2134val EMPTY_FUNSET = store_thm 2135 ("EMPTY_FUNSET", ``!s. FUNSET {} s = (UNIV :('a -> 'b) -> bool)``, 2136 RW_TAC std_ss [EXTENSION, GSPECIFICATION, IN_FUNSET, NOT_IN_EMPTY, IN_UNIV]); 2137 2138Theorem FUNSET_EMPTY: 2139 !s (f :'a -> 'b). f IN (FUNSET s {}) <=> (s = {}) 2140Proof 2141 RW_TAC std_ss [IN_FUNSET, NOT_IN_EMPTY, EXTENSION, GSPECIFICATION] 2142QED 2143 2144val FUNSET_INTER = store_thm 2145 ("FUNSET_INTER", 2146 ``!a b c. FUNSET a (b INTER c) = (FUNSET a b) INTER (FUNSET a c)``, 2147 RW_TAC std_ss [EXTENSION, IN_FUNSET, IN_INTER] 2148 >> PROVE_TAC []); 2149 2150(* (schroeder_close f s) is a set defined as a closure of f^n on set s *) 2151val schroeder_close_def = new_definition ("schroeder_close_def", 2152 ``schroeder_close f s x = ?n. x IN FUNPOW (IMAGE f) n s``); 2153 2154(* fundamental property by definition *) 2155Theorem SCHROEDER_CLOSE: 2156 !f s. x IN (schroeder_close f s) <=> (?n. x IN FUNPOW (IMAGE f) n s) 2157Proof 2158 RW_TAC std_ss [SPECIFICATION, schroeder_close_def] 2159QED 2160 2161val SCHROEDER_CLOSED = store_thm 2162 ("SCHROEDER_CLOSED", 2163 ``!f s. (IMAGE f (schroeder_close f s)) SUBSET (schroeder_close f s)``, 2164 RW_TAC std_ss [SCHROEDER_CLOSE, IN_IMAGE, SUBSET_DEF] 2165 >> Q.EXISTS_TAC `SUC n` 2166 >> RW_TAC std_ss [FUNPOW_SUC, IN_IMAGE] 2167 >> PROVE_TAC []); 2168 2169val SCHROEDER_CLOSE_SUBSET = store_thm 2170 ("SCHROEDER_CLOSE_SUBSET", ``!f s. s SUBSET (schroeder_close f s)``, 2171 RW_TAC std_ss [SCHROEDER_CLOSE, IN_IMAGE, SUBSET_DEF] 2172 >> Q.EXISTS_TAC `0` 2173 >> RW_TAC std_ss [FUNPOW]); 2174 2175val SCHROEDER_CLOSE_SET = store_thm 2176 ("SCHROEDER_CLOSE_SET", 2177 ``!f s t. f IN (FUNSET s s) /\ t SUBSET s ==> (schroeder_close f t) SUBSET s``, 2178 RW_TAC std_ss [SCHROEDER_CLOSE, SUBSET_DEF, IN_FUNSET] 2179 >> POP_ASSUM MP_TAC 2180 >> Q.SPEC_TAC (`x`, `x`) 2181 >> Induct_on `n` >- RW_TAC std_ss [FUNPOW] 2182 >> RW_TAC std_ss [FUNPOW_SUC, IN_IMAGE] 2183 >> PROVE_TAC []); 2184 2185val SCHROEDER_BERNSTEIN_AUTO = store_thm 2186 ("SCHROEDER_BERNSTEIN_AUTO", 2187 ``!s t. t SUBSET s /\ (?f. INJ f s t) ==> ?g. BIJ g s t``, 2188 RW_TAC std_ss [INJ_DEF] 2189 >> Q.EXISTS_TAC `\x. if x IN (schroeder_close f (s DIFF t)) then f x else x` 2190 >> Know `(s DIFF (schroeder_close f (s DIFF t))) SUBSET t` 2191 >- ( RW_TAC std_ss [SUBSET_DEF, IN_DIFF] \\ 2192 Suff `~(x IN s DIFF t)` >- RW_TAC std_ss [IN_DIFF] \\ 2193 PROVE_TAC [SCHROEDER_CLOSE_SUBSET, SUBSET_DEF] ) 2194 >> Know `schroeder_close f (s DIFF t) SUBSET s` 2195 >- ( MATCH_MP_TAC SCHROEDER_CLOSE_SET \\ 2196 RW_TAC std_ss [SUBSET_DEF, IN_DIFF, IN_FUNSET] \\ 2197 PROVE_TAC [SUBSET_DEF] ) 2198 >> Q.PAT_X_ASSUM `t SUBSET s` MP_TAC 2199 >> RW_TAC std_ss [SUBSET_DEF, IN_DIFF] 2200 >> RW_TAC std_ss [BIJ_DEF] (* 2 sub-goals here, first is easy *) 2201 >- ( BasicProvers.NORM_TAC std_ss [INJ_DEF] \\ (* 2 sub-goals, same tactical *) 2202 PROVE_TAC [SCHROEDER_CLOSED, SUBSET_DEF, IN_IMAGE] ) 2203 >> RW_TAC std_ss [SURJ_DEF] (* 2 sub-goals here *) 2204 >| [ (* goal 1 (of 2) *) 2205 REVERSE (Cases_on `x IN (schroeder_close f (s DIFF t))`) >- PROVE_TAC [] \\ 2206 POP_ASSUM MP_TAC >> RW_TAC std_ss [SCHROEDER_CLOSE], 2207 (* goal 2 (of 2) *) 2208 REVERSE (Cases_on `x IN (schroeder_close f (s DIFF t))`) >- PROVE_TAC [] \\ 2209 POP_ASSUM MP_TAC >> RW_TAC std_ss [SCHROEDER_CLOSE] \\ 2210 Cases_on `n` >- (POP_ASSUM MP_TAC >> RW_TAC std_ss [FUNPOW, IN_DIFF]) \\ 2211 POP_ASSUM MP_TAC >> RW_TAC std_ss [FUNPOW_SUC, IN_IMAGE] \\ 2212 Q.EXISTS_TAC `x'` >> POP_ASSUM MP_TAC \\ 2213 Q.SPEC_TAC (`n'`, `n`) >> CONV_TAC FORALL_IMP_CONV \\ 2214 REWRITE_TAC [GSYM SCHROEDER_CLOSE] \\ 2215 RW_TAC std_ss [] ]); 2216 2217val SCHROEDER_BERNSTEIN = store_thm 2218 ("SCHROEDER_BERNSTEIN", 2219 ``!s t. (?f. INJ f s t) /\ (?g. INJ g t s) ==> (?h. BIJ h s t)``, 2220 REPEAT STRIP_TAC 2221 >> MATCH_MP_TAC (INST_TYPE [``:'c`` |-> ``:'a``] BIJ_TRANS) 2222 >> Q.EXISTS_TAC `IMAGE g t` >> CONJ_TAC (* 2 sub-goals here *) 2223 >| [ (* goal 1 (of 2) *) 2224 MATCH_MP_TAC SCHROEDER_BERNSTEIN_AUTO \\ 2225 CONJ_TAC >| (* 2 sub-goals here *) 2226 [ (* goal 1.1 (of 2) *) 2227 POP_ASSUM MP_TAC \\ 2228 RW_TAC std_ss [INJ_DEF, SUBSET_DEF, IN_IMAGE] \\ 2229 PROVE_TAC [], 2230 (* goal 1.2 (of 2) *) 2231 Q.EXISTS_TAC `g o f` >> rpt (POP_ASSUM MP_TAC) \\ 2232 RW_TAC std_ss [INJ_DEF, SUBSET_DEF, IN_IMAGE, combinTheory.o_DEF] \\ 2233 PROVE_TAC [] ], 2234 (* goal 2 (of 2) *) 2235 MATCH_MP_TAC BIJ_SYM_IMP \\ 2236 Q.EXISTS_TAC `g` >> PROVE_TAC [INJ_IMAGE_BIJ] ]); 2237 2238val BIJ_INJ_SURJ = store_thm 2239 ("BIJ_INJ_SURJ", 2240 ``!s t. (?f. INJ f s t) /\ (?g. SURJ g s t) ==> (?h. BIJ h s t)``, 2241 REPEAT STRIP_TAC 2242 >> MATCH_MP_TAC SCHROEDER_BERNSTEIN 2243 >> CONJ_TAC >- PROVE_TAC [] 2244 >> PROVE_TAC [SURJ_IMP_INJ]); 2245 2246Theorem BIJ_ALT: 2247 !f s t. BIJ f s t <=> 2248 f IN (FUNSET s t) /\ (!y. y IN t ==> ?!x. x IN s /\ (y = f x)) 2249Proof 2250 RW_TAC std_ss [BIJ_DEF, INJ_DEF, SURJ_DEF, EXISTS_UNIQUE_ALT] 2251 >> RW_TAC std_ss [IN_FUNSET, IN_DFUNSET, GSYM CONJ_ASSOC] 2252 >> Know `!a b c. (a ==> (b = c)) ==> (a /\ b <=> a /\ c)` >- PROVE_TAC [] 2253 >> DISCH_THEN MATCH_MP_TAC 2254 >> REPEAT (STRIP_TAC ORELSE EQ_TAC) (* 4 sub-goals here *) 2255 >| [ (* goal 1 (of 4) *) 2256 PROVE_TAC [], 2257 (* goal 2 (of 4) *) 2258 Q.PAT_X_ASSUM `!x. P x` 2259 (fn th => 2260 MP_TAC (Q.SPEC `(f :'a-> 'b) x` th) \\ 2261 MP_TAC (Q.SPEC `(f:'a->'b) y` th)) \\ 2262 Cond >- PROVE_TAC [] \\ 2263 STRIP_TAC \\ 2264 Cond >- PROVE_TAC [] \\ 2265 STRIP_TAC >> PROVE_TAC [], 2266 (* goal 3 (of 4) *) 2267 PROVE_TAC [], 2268 (* goal 4 (of 4) *) 2269 PROVE_TAC [] ] 2270QED 2271 2272val BIJ_INSERT_IMP = store_thm (* from util_prob *) 2273 ("BIJ_INSERT_IMP", 2274 ``!f e s t. 2275 ~(e IN s) /\ BIJ f (e INSERT s) t ==> 2276 ?u. (f e INSERT u = t) /\ ~(f e IN u) /\ BIJ f s u``, 2277 RW_TAC std_ss [BIJ_ALT] 2278 >> Q.EXISTS_TAC `t DELETE f e` 2279 >> FULL_SIMP_TAC std_ss [IN_FUNSET, INSERT_DELETE, ELT_IN_DELETE, IN_INSERT, 2280 DISJ_IMP_THM] 2281 >> SIMP_TAC std_ss [IN_DELETE] 2282 >> REPEAT STRIP_TAC (* 3 sub-goals here *) 2283 >> METIS_TAC [IN_INSERT]); 2284 2285val BIJ_IMAGE = store_thm (* from miller *) 2286 ("BIJ_IMAGE", 2287 ``!f s t. BIJ f s t ==> (t = IMAGE f s)``, 2288 RW_TAC std_ss [BIJ_DEF, SURJ_DEF, EXTENSION, IN_IMAGE] 2289 >> PROVE_TAC []); 2290 2291(* ===================================================================== *) 2292(* Left and right inverses. *) 2293(* ===================================================================== *) 2294 2295(* Left inverse, to option type, result is NONE outside image of domain *) 2296val LINV_OPT_def = new_definition ("LINV_OPT_def", 2297 ``LINV_OPT f s y = 2298 if y IN IMAGE f s then SOME (@x. x IN s /\ (f x = y)) else NONE``) ; 2299 2300val SELECT_EQ_AX = Q.prove 2301 (`($@ P = x) ==> $? P ==> P x`, 2302 DISCH_THEN (fn th => REWRITE_TAC [SYM th]) THEN DISCH_TAC THEN 2303 irule SELECT_AX THEN ASM_REWRITE_TAC [ETA_AX]) ; 2304 2305val IN_IMAGE' = Q.prove (`y IN IMAGE f s <=> ?x. x IN s /\ (f x = y)`, 2306 mesonLib.MESON_TAC [IN_IMAGE]) ; 2307 2308val LINV_OPT_THM = Q.store_thm ("LINV_OPT_THM", 2309 `(LINV_OPT f s y = SOME x) ==> x IN s /\ (f x = y)`, 2310 REWRITE_TAC [LINV_OPT_def, IN_IMAGE'] THEN COND_CASES_TAC THEN 2311 REWRITE_TAC [optionTheory.SOME_11, optionTheory.NOT_NONE_SOME] THEN 2312 RULE_ASSUM_TAC (BETA_RULE o 2313 Ho_Rewrite.ONCE_REWRITE_RULE [GSYM SELECT_THM]) THEN 2314 DISCH_TAC THEN BasicProvers.VAR_EQ_TAC THEN FIRST_ASSUM ACCEPT_TAC) ; 2315 2316val INJ_LINV_OPT_IMAGE = Q.store_thm ("INJ_LINV_OPT_IMAGE", 2317 `INJ (LINV_OPT f s) (IMAGE f s) (IMAGE SOME s)`, 2318 REWRITE_TAC [INJ_DEF, LINV_OPT_def] THEN 2319 CONJ_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN 2320 ASM_REWRITE_TAC [optionTheory.SOME_11] THEN 2321 RULE_L_ASSUM_TAC (CONJUNCTS o Ho_Rewrite.REWRITE_RULE [IN_IMAGE', 2322 GSYM SELECT_THM, BETA_THM]) 2323 THENL [ 2324 irule IMAGE_IN THEN FIRST_ASSUM ACCEPT_TAC, 2325 DISCH_THEN (MP_TAC o Q.AP_TERM `f`) THEN ASM_REWRITE_TAC []]) ; 2326 2327Theorem INJ_LINV_OPT: 2328 INJ f s t ==> !x:'a. !y:'b. 2329 (LINV_OPT f s y = SOME x) <=> (y = f x) /\ x IN s /\ y IN t 2330Proof 2331 REWRITE_TAC [LINV_OPT_def, INJ_DEF, IN_IMAGE] THEN 2332 REPEAT STRIP_TAC THEN 2333 REVERSE COND_CASES_TAC THEN FULL_SIMP_TAC std_ss [] THEN1 2334 (POP_ASSUM (ASSUME_TAC o Q.SPEC `x`) THEN REV_FULL_SIMP_TAC std_ss []) THEN 2335 EQ_TAC THENL [ 2336 DISCH_THEN (ASSUME_TAC o MATCH_MP SELECT_EQ_AX) THEN 2337 VALIDATE (POP_ASSUM (fn th => REWRITE_TAC [BETA_RULE (UNDISCH th)])) THEN 2338 Q.EXISTS_TAC `x'` THEN ASM_REWRITE_TAC [], 2339 DISCH_TAC THEN irule SELECT_UNIQUE THEN 2340 BETA_TAC THEN GEN_TAC THEN EQ_TAC 2341 THENL [ 2342 FIRST_X_ASSUM (ASSUME_TAC o Q.SPECL [`y'`, `x`]) THEN 2343 REPEAT STRIP_TAC THEN RES_TAC THEN FULL_SIMP_TAC bool_ss [], 2344 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC []]] 2345QED 2346 2347(* LINV was previously "defined" by new_specification, giving LINV_DEF *) 2348val LINV_LO = new_definition ("LINV_LO", 2349 ``LINV f s y = THE (LINV_OPT f s y)``) ; 2350 2351(* --------------------------------------------------------------------- *) 2352(* LINV_DEF: *) 2353(* |- !f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s(f x) = x)) *) 2354(* --------------------------------------------------------------------- *) 2355 2356val LINV_DEF = Q.store_thm ("LINV_DEF", 2357 `!f s t. INJ f s t ==> (!x. x IN s ==> (LINV f s (f x) = x))`, 2358 REWRITE_TAC [LINV_LO] THEN REPEAT GEN_TAC THEN 2359 DISCH_THEN (fn th => ASSUME_TAC th THEN 2360 ASSUME_TAC (MATCH_MP INJ_LINV_OPT th)) THEN 2361 GEN_TAC THEN POP_ASSUM (ASSUME_TAC o Q.SPECL [`x`, `f x`]) THEN 2362 DISCH_TAC THEN FULL_SIMP_TAC std_ss [INJ_DEF] THEN 2363 RES_TAC THEN FULL_SIMP_TAC std_ss []) ; 2364 2365val BIJ_LINV_INV = Q.store_thm ( 2366"BIJ_LINV_INV", 2367`!f s t. BIJ f s t ==> !x. x IN t ==> (f (LINV f s x) = x)`, 2368RW_TAC bool_ss [BIJ_DEF] THEN 2369IMP_RES_TAC LINV_DEF THEN FULL_SIMP_TAC bool_ss [INJ_DEF, SURJ_DEF] THEN 2370METIS_TAC []); 2371 2372val BIJ_LINV_BIJ = Q.store_thm ( 2373"BIJ_LINV_BIJ", 2374`!f s t. BIJ f s t ==> BIJ (LINV f s) t s`, 2375RW_TAC bool_ss [BIJ_DEF] THEN 2376IMP_RES_TAC LINV_DEF THEN FULL_SIMP_TAC bool_ss [INJ_DEF, SURJ_DEF] THEN 2377METIS_TAC []); 2378 2379Theorem BIJ_IFF_INV: 2380 !f s t. BIJ f s t <=> 2381 (!x. x IN s ==> f x IN t) /\ 2382 ?g. (!x. x IN t ==> g x IN s) /\ 2383 (!x. x IN s ==> (g (f x) = x)) /\ 2384 (!x. x IN t ==> (f (g x) = x)) 2385Proof 2386REPEAT GEN_TAC THEN 2387EQ_TAC THEN STRIP_TAC THEN1 ( 2388 CONJ_TAC THEN1 METIS_TAC [BIJ_DEF,INJ_DEF] THEN 2389 Q.EXISTS_TAC `LINV f s` THEN 2390 IMP_RES_TAC BIJ_LINV_BIJ THEN 2391 CONJ_TAC THEN1 METIS_TAC [BIJ_DEF,INJ_DEF] THEN 2392 CONJ_TAC THEN1 METIS_TAC [BIJ_DEF,LINV_DEF] THEN 2393 METIS_TAC [BIJ_LINV_INV] ) THEN 2394SRW_TAC [][BIJ_DEF,INJ_DEF,SURJ_DEF] THEN 2395METIS_TAC [] 2396QED 2397 2398Theorem BIJ_support: 2399 !f s' s. 2400 BIJ f s' s' /\ s' SUBSET s /\ (!x. x NOTIN s' ==> (f x = x)) ==> 2401 BIJ f s s 2402Proof 2403 rw[BIJ_IFF_INV,SUBSET_DEF] >- METIS_TAC[] 2404 \\ Q.EXISTS_TAC ���\x. if x IN s' then g x else x��� 2405 \\ rw[] \\ METIS_TAC[] 2406QED 2407 2408val BIJ_INSERT = store_thm( 2409 "BIJ_INSERT", 2410 ``!f e s t. BIJ f (e INSERT s) t <=> 2411 e NOTIN s /\ f e IN t /\ BIJ f s (t DELETE f e) \/ 2412 e IN s /\ BIJ f s t``, 2413 REPEAT GEN_TAC THEN 2414 Cases_on `e IN s` THEN1 2415 (SRW_TAC [][ABSORPTION |> SPEC_ALL |> EQ_IMP_RULE |> #1]) THEN 2416 SRW_TAC [][] THEN SRW_TAC [][BIJ_IFF_INV] THEN EQ_TAC THENL [ 2417 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM] THEN METIS_TAC [], 2418 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM] THEN 2419 Q.EXISTS_TAC `\x. if x = f e then e else g x` THEN 2420 SRW_TAC [][] 2421 ]); 2422 2423(* RINV was previously "defined" by new_specification, giving RINV_DEF *) 2424val RINV_LO = new_definition ("RINV_LO", 2425 ``RINV f s y = THE (LINV_OPT f s y)``) ; 2426 2427(* --------------------------------------------------------------------- *) 2428(* RINV_DEF: *) 2429(* |- !f s t. SURJ f s t ==> (!x. x IN t ==> (f(RINV f s x) = x)) *) 2430(* --------------------------------------------------------------------- *) 2431 2432val RINV_DEF = Q.store_thm ("RINV_DEF", 2433 `!f s t. SURJ f s t ==> (!x. x IN t ==> (f (RINV f s x) = x))`, 2434 REPEAT GEN_TAC THEN 2435 DISCH_THEN (fn th => ASSUME_TAC th THEN 2436 ASSUME_TAC (REWRITE_RULE [IMAGE_SURJ] th)) THEN 2437 REPEAT STRIP_TAC THEN 2438 FULL_SIMP_TAC std_ss [RINV_LO, SURJ_DEF, LINV_OPT_def, 2439 optionTheory.THE_DEF] THEN 2440 RES_TAC THEN 2441 irule (BETA_RULE (Q.SPECL [`P`, `\y. f y = x`] SELECT_ELIM_THM)) THEN 2442 CONJ_TAC THEN1 SIMP_TAC std_ss [] THEN 2443 Q.EXISTS_TAC `y` THEN ASM_SIMP_TAC std_ss []) ; 2444 2445val SURJ_INJ_INV = store_thm( 2446 "SURJ_INJ_INV", 2447 ``SURJ f s t ==> ?g. INJ g t s /\ !y. y IN t ==> (f (g y) = y)``, 2448 REWRITE_TAC [IMAGE_SURJ] THEN 2449 DISCH_TAC THEN Q.EXISTS_TAC `THE o LINV_OPT f s` THEN 2450 BasicProvers.VAR_EQ_TAC THEN REPEAT STRIP_TAC 2451 THENL [ 2452 irule INJ_COMPOSE THEN Q.EXISTS_TAC `IMAGE SOME s` THEN 2453 REWRITE_TAC [INJ_LINV_OPT_IMAGE] THEN REWRITE_TAC [INJ_DEF, IN_IMAGE] THEN 2454 REPEAT STRIP_TAC THEN REPEAT BasicProvers.VAR_EQ_TAC THEN 2455 FULL_SIMP_TAC std_ss [optionTheory.THE_DEF], 2456 ASM_REWRITE_TAC [LINV_OPT_def, combinTheory.o_THM, optionTheory.THE_DEF] THEN 2457 RULE_ASSUM_TAC (Ho_Rewrite.REWRITE_RULE 2458 [IN_IMAGE', GSYM SELECT_THM, BETA_THM]) THEN ASM_REWRITE_TAC [] ]) ; 2459 2460(* ===================================================================== *) 2461(* Finiteness *) 2462(* ===================================================================== *) 2463 2464val FINITE_DEF = 2465 new_definition 2466 ("FINITE_DEF", 2467 (���!s:'a set. 2468 FINITE s = !P. P EMPTY /\ (!s. P s ==> !e. P (e INSERT s)) ==> P s���)); 2469val _ = ot0 "FINITE" "finite" 2470 2471val FINITE_EMPTY = 2472 store_thm 2473 ("FINITE_EMPTY", 2474 (���FINITE (EMPTY:'a set)���), 2475 PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN 2476 REPEAT STRIP_TAC); 2477 2478val FINITE_INSERT = 2479 TAC_PROOF 2480 (([], (���!s. FINITE s ==> !x:'a. FINITE (x INSERT s)���)), 2481 PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN 2482 REPEAT STRIP_TAC THEN SPEC_TAC ((���x:'a���),(���x:'a���)) THEN 2483 REPEAT (FIRST_ASSUM MATCH_MP_TAC) THEN 2484 CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC); 2485 2486val SIMPLE_FINITE_INDUCT = 2487 TAC_PROOF 2488 (([], (���!P. P EMPTY /\ (!s. P s ==> (!e:'a. P(e INSERT s))) 2489 ==> 2490 !s. FINITE s ==> P s���)), 2491 GEN_TAC THEN STRIP_TAC THEN 2492 PURE_ONCE_REWRITE_TAC [FINITE_DEF] THEN 2493 GEN_TAC THEN DISCH_THEN MATCH_MP_TAC THEN 2494 ASM_REWRITE_TAC []); 2495 2496val lemma = 2497 let val tac = ASM_CASES_TAC (���P:bool���) THEN ASM_REWRITE_TAC[] 2498 val lem = TAC_PROOF(([],(���(P ==> P /\ Q) = (P ==> Q)���)), tac) 2499 val th1 = SPEC (���\s:'a set. FINITE s /\ P s���) 2500 SIMPLE_FINITE_INDUCT 2501 in REWRITE_RULE [lem,FINITE_EMPTY] (BETA_RULE th1) 2502 end; 2503 2504val FINITE_INDUCT = store_thm("FINITE_INDUCT", 2505 ``!P. P {} /\ (!s. FINITE s /\ P s ==> (!e. ~(e IN s) ==> P(e INSERT s))) ==> 2506 !s:'a set. FINITE s ==> P s``, 2507 GEN_TAC THEN STRIP_TAC THEN 2508 MATCH_MP_TAC lemma THEN 2509 ASM_REWRITE_TAC [] THEN 2510 REPEAT STRIP_TAC THENL 2511 [IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT, 2512 ASM_CASES_TAC (���(e:'a) IN s���) THENL 2513 [IMP_RES_THEN SUBST1_TAC ABSORPTION, RES_TAC] THEN 2514 ASM_REWRITE_TAC []]); 2515 2516val _ = IndDefLib.export_rule_induction "FINITE_INDUCT"; 2517 2518(* --------------------------------------------------------------------- *) 2519(* Load the set induction tactic in... *) 2520(* --------------------------------------------------------------------- *) 2521 2522val SET_INDUCT_TAC = PSet_ind.SET_INDUCT_TAC FINITE_INDUCT; 2523 2524val set_tyinfo = TypeBasePure.mk_nondatatype_info 2525 (``:'a set``, 2526 {nchotomy = SOME SET_CASES, 2527 induction= SOME FINITE_INDUCT, 2528 size=NONE, 2529 encode=NONE}); 2530 2531val _ = TypeBase.export [set_tyinfo]; 2532 2533val FINITE_DELETE = 2534 TAC_PROOF 2535 (([], ���!s. FINITE s ==> !x:'a. FINITE (s DELETE x)���), 2536 SET_INDUCT_TAC THENL 2537 [REWRITE_TAC [EMPTY_DELETE,FINITE_EMPTY], 2538 PURE_ONCE_REWRITE_TAC [DELETE_INSERT] THEN 2539 REPEAT STRIP_TAC THEN 2540 COND_CASES_TAC THENL 2541 [FIRST_ASSUM MATCH_ACCEPT_TAC, 2542 FIRST_ASSUM (fn th => fn g => ASSUME_TAC (SPEC (���x:'a���) th) g) THEN 2543 IMP_RES_TAC FINITE_INSERT THEN 2544 FIRST_ASSUM MATCH_ACCEPT_TAC]]); 2545 2546val INSERT_FINITE = 2547 TAC_PROOF 2548 (([], (���!x:'a. !s. FINITE(x INSERT s) ==> FINITE s���)), 2549 REPEAT GEN_TAC THEN ASM_CASES_TAC (���(x:'a) IN s���) THENL 2550 [IMP_RES_TAC ABSORPTION THEN ASM_REWRITE_TAC [], 2551 DISCH_THEN (MP_TAC o SPEC (���x:'a���) o MATCH_MP FINITE_DELETE) THEN 2552 REWRITE_TAC [DELETE_INSERT] THEN 2553 IMP_RES_TAC DELETE_NON_ELEMENT THEN ASM_REWRITE_TAC[]]); 2554 2555val FINITE_INSERT = 2556 store_thm 2557 ("FINITE_INSERT", 2558 (���!x:'a. !s. FINITE(x INSERT s) = FINITE s���), 2559 REPEAT GEN_TAC THEN EQ_TAC THENL 2560 [MATCH_ACCEPT_TAC INSERT_FINITE, 2561 DISCH_THEN (MATCH_ACCEPT_TAC o MATCH_MP FINITE_INSERT)]); 2562 2563val _ = export_rewrites ["FINITE_EMPTY", "FINITE_INSERT"] 2564 2565val DELETE_FINITE = 2566 TAC_PROOF 2567 (([], (���!x:'a. !s. FINITE (s DELETE x) ==> FINITE s���)), 2568 REPEAT GEN_TAC THEN ASM_CASES_TAC (���(x:'a) IN s���) THEN 2569 DISCH_TAC THENL 2570 [IMP_RES_THEN (SUBST1_TAC o SYM) INSERT_DELETE THEN 2571 ASM_REWRITE_TAC [FINITE_INSERT], 2572 IMP_RES_THEN (SUBST1_TAC o SYM) DELETE_NON_ELEMENT THEN 2573 FIRST_ASSUM ACCEPT_TAC]); 2574 2575 2576Theorem FINITE_DELETE[simp]: 2577 !x:'a. !s. FINITE(s DELETE x) <=> FINITE s 2578Proof 2579 REPEAT GEN_TAC THEN EQ_TAC THENL 2580 [MATCH_ACCEPT_TAC DELETE_FINITE, 2581 DISCH_THEN (MATCH_ACCEPT_TAC o MATCH_MP FINITE_DELETE)] 2582QED 2583 2584val FINITE_REST = 2585 store_thm 2586 ("FINITE_REST", 2587 (���!s:'a set. FINITE s ==> FINITE (REST s)���), 2588 REWRITE_TAC [REST_DEF, FINITE_DELETE]); 2589 2590val FINITE_REST_EQ = store_thm (* from util_prob *) 2591 ("FINITE_REST_EQ", 2592 ``!s. FINITE (REST s) = FINITE s``, 2593 RW_TAC std_ss [REST_DEF, FINITE_DELETE]); 2594 2595val UNION_FINITE = prove( 2596 ���!s:'a set. FINITE s ==> !t. FINITE t ==> FINITE (s UNION t)���, 2597 SET_INDUCT_TAC THENL [ 2598 REWRITE_TAC [UNION_EMPTY], 2599 SET_INDUCT_TAC THENL [ 2600 IMP_RES_TAC FINITE_INSERT THEN ASM_REWRITE_TAC [UNION_EMPTY], 2601 `(e INSERT s) UNION (e' INSERT s') = 2602 s UNION (e INSERT e' INSERT s')` by 2603 SIMP_TAC bool_ss [IN_UNION, EXTENSION, IN_INSERT, NOT_IN_EMPTY, 2604 EQ_IMP_THM, FORALL_AND_THM, DISJ_IMP_THM] THEN 2605 ASM_SIMP_TAC bool_ss [FINITE_INSERT, FINITE_EMPTY] 2606 ] 2607 ]); 2608 2609val FINITE_UNION_LEMMA = TAC_PROOF(([], 2610���!s:'a set. FINITE s ==> !t. FINITE (s UNION t) ==> FINITE t���), 2611 SET_INDUCT_TAC THENL 2612 [REWRITE_TAC [UNION_EMPTY], 2613 GEN_TAC THEN ASM_REWRITE_TAC [INSERT_UNION] THEN 2614 COND_CASES_TAC THENL 2615 [FIRST_ASSUM MATCH_ACCEPT_TAC, 2616 DISCH_THEN (MP_TAC o MATCH_MP INSERT_FINITE) THEN 2617 FIRST_ASSUM MATCH_ACCEPT_TAC]]); 2618 2619val FINITE_UNION = prove( 2620 ���!s:'a set. !t. FINITE(s UNION t) ==> (FINITE s /\ FINITE t)���, 2621 REPEAT STRIP_TAC THEN IMP_RES_THEN MATCH_MP_TAC FINITE_UNION_LEMMA THEN 2622 PROVE_TAC [UNION_COMM, UNION_ASSOC, UNION_IDEMPOT]); 2623 2624Theorem FINITE_UNION[simp]: 2625 !s:'a set. !t. FINITE(s UNION t) <=> FINITE s /\ FINITE t 2626Proof 2627 REPEAT STRIP_TAC THEN EQ_TAC THENL 2628 [REPEAT STRIP_TAC THEN IMP_RES_TAC FINITE_UNION, 2629 REPEAT STRIP_TAC THEN IMP_RES_TAC UNION_FINITE] 2630QED 2631 2632val INTER_FINITE = 2633 store_thm 2634 ("INTER_FINITE", 2635 (���!s:'a set. FINITE s ==> !t. FINITE (s INTER t)���), 2636 SET_INDUCT_TAC THENL 2637 [REWRITE_TAC [INTER_EMPTY,FINITE_EMPTY], 2638 REWRITE_TAC [INSERT_INTER] THEN GEN_TAC THEN 2639 COND_CASES_TAC THENL 2640 [FIRST_ASSUM (fn th => fn g => ASSUME_TAC (SPEC (���t:'a set���) th) g 2641 handle _ => NO_TAC g) THEN 2642 IMP_RES_TAC FINITE_INSERT THEN 2643 FIRST_ASSUM MATCH_ACCEPT_TAC, 2644 FIRST_ASSUM MATCH_ACCEPT_TAC]]); 2645 2646val SUBSET_FINITE = 2647 store_thm 2648 ("SUBSET_FINITE", 2649 (���!s:'a set. FINITE s ==> (!t. t SUBSET s ==> FINITE t)���), 2650 SET_INDUCT_TAC THENL 2651 [PURE_ONCE_REWRITE_TAC [SUBSET_EMPTY] THEN 2652 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [FINITE_EMPTY], 2653 GEN_TAC THEN ASM_CASES_TAC (���(e:'a) IN t���) THENL 2654 [REWRITE_TAC [SUBSET_INSERT_DELETE] THEN 2655 STRIP_TAC THEN RES_TAC THEN IMP_RES_TAC DELETE_FINITE, 2656 IMP_RES_TAC SUBSET_INSERT THEN ASM_REWRITE_TAC []]]); 2657 2658val SUBSET_FINITE_I = store_thm( 2659 "SUBSET_FINITE_I", 2660 ``!s t. FINITE s /\ t SUBSET s ==> FINITE t``, 2661 METIS_TAC [SUBSET_FINITE]); 2662 2663 2664val PSUBSET_FINITE = 2665 store_thm 2666 ("PSUBSET_FINITE", 2667 (���!s:'a set. FINITE s ==> (!t. t PSUBSET s ==> FINITE t)���), 2668 PURE_ONCE_REWRITE_TAC [PSUBSET_DEF] THEN 2669 REPEAT STRIP_TAC THEN IMP_RES_TAC SUBSET_FINITE); 2670 2671val FINITE_DIFF = 2672 store_thm 2673 ("FINITE_DIFF", 2674 (���!s:'a set. FINITE s ==> !t. FINITE(s DIFF t)���), 2675 SET_INDUCT_TAC THENL 2676 [REWRITE_TAC [EMPTY_DIFF,FINITE_EMPTY], 2677 ASM_REWRITE_TAC [INSERT_DIFF] THEN 2678 GEN_TAC THEN COND_CASES_TAC THENL 2679 [FIRST_ASSUM MATCH_ACCEPT_TAC, 2680 FIRST_ASSUM (fn th => fn g => ASSUME_TAC (SPEC (���t:'a set���)th) g) 2681 THEN IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT]]); 2682val _ = export_rewrites ["FINITE_DIFF"] 2683 2684Theorem FINITE_DIFF_down: 2685 !P Q. FINITE (P DIFF Q) /\ FINITE Q ==> FINITE P 2686Proof 2687 Induct_on ���FINITE Q��� >> 2688 SRW_TAC [][DIFF_EMPTY] >> 2689 PROVE_TAC [DIFF_INSERT, FINITE_DELETE] 2690QED 2691 2692val FINITE_SING = 2693 store_thm 2694 ("FINITE_SING", 2695 (���!x:'a. FINITE {x}���), 2696 GEN_TAC THEN MP_TAC FINITE_EMPTY THEN 2697 SUBST1_TAC (SYM (SPEC (���x:'a���) SING_DELETE)) THEN 2698 DISCH_TAC THEN IMP_RES_THEN MATCH_ACCEPT_TAC FINITE_INSERT); 2699val _ = export_rewrites ["FINITE_SING"] 2700 2701val SING_FINITE = 2702 store_thm 2703 ("SING_FINITE", 2704 (���!s:'a set. SING s ==> FINITE s���), 2705 PURE_ONCE_REWRITE_TAC [SING_DEF] THEN 2706 GEN_TAC THEN DISCH_THEN (STRIP_THM_THEN SUBST1_TAC) THEN 2707 MATCH_ACCEPT_TAC FINITE_SING); 2708 2709val IMAGE_FINITE = 2710 store_thm 2711 ("IMAGE_FINITE", 2712 (���!s. FINITE s ==> !f:'a->'b. FINITE(IMAGE f s)���), 2713 SET_INDUCT_TAC THENL 2714 [REWRITE_TAC [IMAGE_EMPTY,FINITE_EMPTY], 2715 ASM_REWRITE_TAC [IMAGE_INSERT,FINITE_INSERT]]); 2716 2717Theorem FINITELY_INJECTIVE_IMAGE_FINITE: 2718 !f. (!x. FINITE { y | x = f y }) ==> !s. FINITE (IMAGE f s) = FINITE s 2719Proof 2720 GEN_TAC THEN STRIP_TAC THEN 2721 SIMP_TAC (srw_ss()) [EQ_IMP_THM, FORALL_AND_THM, IMAGE_FINITE] THEN 2722 Induct_on ���FINITE��� THEN 2723 SRW_TAC [][] THEN 2724 Q.RENAME_TAC [���IMAGE f P = e INSERT Q���] THEN 2725 `Q = IMAGE f (P DIFF { y | e = f y})` 2726 by (POP_ASSUM MP_TAC THEN 2727 SRW_TAC [][EXTENSION, IN_IMAGE, GSPECIFICATION] THEN 2728 PROVE_TAC []) THEN 2729 `FINITE (P DIFF { y | e = f y})` by PROVE_TAC [] THEN 2730 METIS_TAC [FINITE_DIFF_down] 2731QED 2732 2733val INJECTIVE_IMAGE_FINITE = Q.store_thm 2734("INJECTIVE_IMAGE_FINITE", 2735 `!f. (!x y. (f x = f y) = (x = y)) ==> 2736 !s. FINITE (IMAGE f s) = FINITE s`, 2737 REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITELY_INJECTIVE_IMAGE_FINITE THEN 2738 GEN_TAC THEN Cases_on `?e. x = f e` THENL [ 2739 POP_ASSUM STRIP_ASSUME_TAC THEN 2740 Q_TAC SUFF_TAC `{y | x = f y} = {e}` THEN1 SRW_TAC [][] THEN 2741 ASM_SIMP_TAC (srw_ss()) [GSPECIFICATION, EXTENSION] THEN PROVE_TAC [], 2742 Q_TAC SUFF_TAC `{y | x = f y} = {}` THEN1 SRW_TAC [][] THEN 2743 FULL_SIMP_TAC (srw_ss()) [EXTENSION, GSPECIFICATION] 2744 ]); 2745val _ = export_rewrites ["INJECTIVE_IMAGE_FINITE"] 2746 2747val lem = Q.prove 2748(`!t. FINITE t ==> !s f. INJ f s t ==> FINITE s`, 2749 SET_INDUCT_TAC 2750 THEN RW_TAC bool_ss [INJ_EMPTY,FINITE_EMPTY] 2751 THEN Cases_on `?a. a IN s' /\ (f a = e)` 2752 THEN POP_ASSUM (STRIP_ASSUME_TAC o SIMP_RULE bool_ss []) THENL 2753 [RW_TAC bool_ss [] 2754 THEN IMP_RES_TAC INJ_DELETE 2755 THEN FULL_SIMP_TAC bool_ss [DELETE_INSERT] 2756 THEN METIS_TAC [DELETE_NON_ELEMENT,FINITE_DELETE], 2757 Q.PAT_X_ASSUM `INJ x y z` MP_TAC 2758 THEN RW_TAC bool_ss [INJ_DEF] 2759 THEN `!x. x IN s' ==> f x IN s` by METIS_TAC [IN_INSERT] 2760 THEN `INJ f s' s` by METIS_TAC [INJ_DEF] 2761 THEN METIS_TAC[]]); 2762 2763val FINITE_INJ = Q.store_thm 2764("FINITE_INJ", 2765 `!(f:'a->'b) s t. INJ f s t /\ FINITE t ==> FINITE s`, 2766 METIS_TAC [lem]); 2767 2768val REL_RESTRICT_DEF = new_definition( 2769 "REL_RESTRICT_DEF", 2770 ``REL_RESTRICT R s x y <=> x IN s /\ y IN s /\ R x y``); 2771 2772val REL_RESTRICT_EMPTY = store_thm( 2773 "REL_RESTRICT_EMPTY", 2774 ``REL_RESTRICT R {} = REMPTY``, 2775 SRW_TAC [][REL_RESTRICT_DEF, FUN_EQ_THM]); 2776val _ = export_rewrites ["REL_RESTRICT_EMPTY"] 2777 2778val REL_RESTRICT_SUBSET = store_thm( 2779 "REL_RESTRICT_SUBSET", 2780 ``s1 SUBSET s2 ==> REL_RESTRICT R s1 RSUBSET REL_RESTRICT R s2``, 2781 SRW_TAC [][relationTheory.RSUBSET, REL_RESTRICT_DEF, SUBSET_DEF]); 2782 2783(* =====================================================================*) 2784(* Cardinality *) 2785(* =====================================================================*) 2786 2787(* --------------------------------------------------------------------- *) 2788(* card_rel_def: defining equations for a relation `R s n`, which means *) 2789(* that the finite s has cardinality n. *) 2790(* --------------------------------------------------------------------- *) 2791 2792val card_rel_def = 2793 (���(!s. R s 0 = (s = EMPTY)) /\ 2794 (!s n. R s (SUC n) = ?x:'a. x IN s /\ R (s DELETE x) n)���); 2795 2796(* ---------------------------------------------------------------------*) 2797(* Prove that such a relation exists. *) 2798(* ---------------------------------------------------------------------*) 2799 2800val CARD_REL_EXISTS = prove_rec_fn_exists num_Axiom card_rel_def; 2801 2802(* ---------------------------------------------------------------------*) 2803(* Now, prove that it doesn't matter which element we delete *) 2804(* Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] *) 2805(* ---------------------------------------------------------------------*) 2806 2807val CARD_REL_DEL_LEMMA = 2808 TAC_PROOF 2809 ((strip_conj card_rel_def, 2810 (���!(n:num) s (x:'a). 2811 x IN s ==> 2812 R (s DELETE x) n ==> 2813 !y:'a. y IN s ==> R (s DELETE y) n���)), 2814 INDUCT_TAC THENL 2815 [REPEAT GEN_TAC THEN DISCH_TAC THEN 2816 IMP_RES_TAC DELETE_EQ_SING THEN ASM_REWRITE_TAC [] THEN 2817 DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [IN_SING] THEN 2818 GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC [SING_DELETE], 2819 ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN 2820 let val th = (SPEC (���y:'a = x'���) EXCLUDED_MIDDLE) 2821 in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th 2822 end 2823 THENL 2824 [MP_TAC (SPECL [(���s:'a set���),(���x:'a���),(���x':'a���)] 2825 IN_DELETE_EQ) THEN 2826 ASM_REWRITE_TAC [] THEN DISCH_TAC THEN 2827 PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN 2828 EXISTS_TAC (���x:'a���) THEN ASM_REWRITE_TAC[], 2829 let val th = (SPEC (���x:'a = y���) EXCLUDED_MIDDLE) 2830 in DISJ_CASES_THEN2 SUBST_ALL_TAC ASSUME_TAC th 2831 end 2832 THENL 2833 [EXISTS_TAC (���x':'a���) THEN ASM_REWRITE_TAC [], 2834 EXISTS_TAC (���x:'a���) THEN ASM_REWRITE_TAC [IN_DELETE] THEN 2835 RES_THEN (TRY o IMP_RES_THEN ASSUME_TAC) THEN 2836 PURE_ONCE_REWRITE_TAC [DELETE_COMM] THEN 2837 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [IN_DELETE] THEN 2838 CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN FIRST_ASSUM ACCEPT_TAC]]]); 2839 2840 2841(* --------------------------------------------------------------------- *) 2842(* So `R s` specifies a unique number. *) 2843(* --------------------------------------------------------------------- *) 2844 2845val CARD_REL_UNIQUE = 2846 TAC_PROOF 2847 ((strip_conj card_rel_def, 2848 (���!n:num. !s:'a set. R s n ==> (!m. R s m ==> (n = m))���)), 2849 INDUCT_TAC THEN ASM_REWRITE_TAC [] THENL 2850 [GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN 2851 CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THENL 2852 [STRIP_TAC THEN REFL_TAC, ASM_REWRITE_TAC[NOT_SUC,NOT_IN_EMPTY]], 2853 GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL 2854 [ASM_REWRITE_TAC [NOT_SUC,SYM(SPEC_ALL MEMBER_NOT_EMPTY)] THEN 2855 EXISTS_TAC (���x:'a���) THEN FIRST_ASSUM ACCEPT_TAC, 2856 ASM_REWRITE_TAC [INV_SUC_EQ] THEN STRIP_TAC THEN 2857 IMP_RES_TAC CARD_REL_DEL_LEMMA THEN RES_TAC]]); 2858 2859(* --------------------------------------------------------------------- *) 2860(* Now, ?n. R s n if s is finite. *) 2861(* --------------------------------------------------------------------- *) 2862 2863val CARD_REL_EXISTS_LEMMA = TAC_PROOF 2864((strip_conj card_rel_def, 2865 (���!s:'a set. FINITE s ==> ?n:num. R s n���)), 2866 SET_INDUCT_TAC THENL 2867 [EXISTS_TAC (���0���) THEN ASM_REWRITE_TAC[], 2868 FIRST_ASSUM (fn th => fn g => CHOOSE_THEN ASSUME_TAC th g) THEN 2869 EXISTS_TAC (���SUC n���) THEN ASM_REWRITE_TAC [] THEN 2870 EXISTS_TAC (���e:'a���) THEN IMP_RES_TAC DELETE_NON_ELEMENT THEN 2871 ASM_REWRITE_TAC [DELETE_INSERT,IN_INSERT]]); 2872 2873(* ---------------------------------------------------------------------*) 2874(* So (@n. R s n) = m iff R s m (\s.@n.R s n defines a function) *) 2875(* Proof modified for Version 12 IMP_RES_THEN [TFM 91.01.23] *) 2876(* ---------------------------------------------------------------------*) 2877 2878val CARD_REL_THM = 2879 TAC_PROOF 2880 ((strip_conj card_rel_def, 2881 (���!m s. FINITE s ==> (((@n:num. R (s:'a set) n) = m) = R s m)���)), 2882 REPEAT STRIP_TAC THEN 2883 IMP_RES_TAC CARD_REL_EXISTS_LEMMA THEN 2884 EQ_TAC THENL 2885 [DISCH_THEN (SUBST1_TAC o SYM) THEN CONV_TAC SELECT_CONV THEN 2886 EXISTS_TAC (���n:num���) THEN FIRST_ASSUM MATCH_ACCEPT_TAC, 2887 STRIP_TAC THEN 2888 IMP_RES_THEN ASSUME_TAC CARD_REL_UNIQUE THEN 2889 CONV_TAC SYM_CONV THEN 2890 FIRST_ASSUM MATCH_MP_TAC THEN 2891 CONV_TAC SELECT_CONV THEN 2892 EXISTS_TAC (���n:num���) THEN FIRST_ASSUM MATCH_ACCEPT_TAC]); 2893 2894(* ---------------------------------------------------------------------*) 2895(* Now, prove the existence of the required cardinality function. *) 2896(* ---------------------------------------------------------------------*) 2897 2898val CARD_EXISTS = TAC_PROOF(([], 2899(��� ?CARD. 2900 (CARD EMPTY = 0) /\ 2901 (!s. FINITE s ==> 2902 !x:'a. CARD(x INSERT s) = (if x IN s then CARD s else SUC(CARD s)))���)), 2903 STRIP_ASSUME_TAC CARD_REL_EXISTS THEN 2904 EXISTS_TAC (���\s:'a set. @n:num. R s n���) THEN 2905 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN CONJ_TAC THENL 2906 [ASSUME_TAC FINITE_EMPTY THEN IMP_RES_TAC CARD_REL_THM THEN 2907 FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC [], 2908 REPEAT STRIP_TAC THEN COND_CASES_TAC THENL 2909 [IMP_RES_THEN SUBST1_TAC ABSORPTION THEN REFL_TAC, 2910 IMP_RES_THEN (ASSUME_TAC o SPEC (���x:'a���)) FINITE_INSERT THEN 2911 IMP_RES_THEN (TRY o MATCH_MP_TAC) CARD_REL_THM THEN 2912 ASM_REWRITE_TAC [] THEN EXISTS_TAC (���x:'a���) THEN 2913 IMP_RES_TAC DELETE_NON_ELEMENT THEN 2914 ASM_REWRITE_TAC [IN_INSERT,DELETE_INSERT] THEN 2915 CONV_TAC SELECT_CONV THEN 2916 IMP_RES_THEN (TRY o MATCH_ACCEPT_TAC) CARD_REL_EXISTS_LEMMA]]); 2917 2918(* ---------------------------------------------------------------------*) 2919(* Finally, introduce the CARD function via a constant specification. *) 2920(* ---------------------------------------------------------------------*) 2921 2922val CARD_DEF = new_specification ("CARD_DEF", ["CARD"], CARD_EXISTS); 2923 2924(* ---------------------------------------------------------------------*) 2925(* Various cardinality results. *) 2926(* ---------------------------------------------------------------------*) 2927 2928val CARD_EMPTY = save_thm("CARD_EMPTY",CONJUNCT1 CARD_DEF); 2929val _ = export_rewrites ["CARD_EMPTY"] 2930 2931val CARD_INSERT = save_thm("CARD_INSERT",CONJUNCT2 CARD_DEF); 2932val _ = export_rewrites ["CARD_INSERT"] 2933 2934val CARD_EQ_0 = 2935 store_thm 2936 ("CARD_EQ_0", 2937 (���!s:'a set. FINITE s ==> ((CARD s = 0) = (s = EMPTY))���), 2938 SET_INDUCT_TAC THENL 2939 [REWRITE_TAC [CARD_EMPTY], 2940 IMP_RES_TAC CARD_INSERT THEN 2941 ASM_REWRITE_TAC [NOT_INSERT_EMPTY,NOT_SUC]]); 2942 2943val CARD_DELETE = 2944 store_thm 2945 ("CARD_DELETE", 2946 (���!s. FINITE s ==> 2947 !x:'a. CARD(s DELETE x) = if x IN s then CARD s - 1 else CARD s���), 2948 SET_INDUCT_TAC THENL 2949 [REWRITE_TAC [EMPTY_DELETE,NOT_IN_EMPTY], 2950 PURE_REWRITE_TAC [DELETE_INSERT,IN_INSERT] THEN 2951 REPEAT GEN_TAC THEN ASM_CASES_TAC (���x:'a = e���) THENL 2952 [IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [SUC_SUB1], 2953 SUBST1_TAC (SPECL [(���e:'a���),(���x:'a���)] EQ_SYM_EQ) THEN 2954 IMP_RES_THEN (ASSUME_TAC o SPEC (���x:'a���)) FINITE_DELETE THEN 2955 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [IN_DELETE,SUC_SUB1] THEN 2956 COND_CASES_TAC THEN ASM_REWRITE_TAC [] THEN 2957 STRIP_ASSUME_TAC (SPEC (���CARD(s:'a set)���) num_CASES) THENL 2958 [let fun tac th g = SUBST_ALL_TAC th g handle _ => ASSUME_TAC th g 2959 in REPEAT_GTCL IMP_RES_THEN tac CARD_EQ_0 2960 end THEN IMP_RES_TAC NOT_IN_EMPTY, 2961 ASM_REWRITE_TAC [SUC_SUB1]]]]); 2962 2963 2964val lemma1 = 2965 TAC_PROOF 2966 (([], (���!n m. (SUC n <= SUC m) = (n <= m)���)), 2967 REWRITE_TAC [LESS_OR_EQ,INV_SUC_EQ,LESS_MONO_EQ]); 2968 2969val lemma2 = 2970 TAC_PROOF 2971 (([], (���!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))���)), 2972 REWRITE_TAC [LESS_OR_EQ,LESS_THM] THEN 2973 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]); 2974 2975val CARD_INTER_LESS_EQ = 2976 store_thm 2977 ("CARD_INTER_LESS_EQ", 2978 (���!s:'a set. FINITE s ==> !t. CARD (s INTER t) <= CARD s���), 2979 SET_INDUCT_TAC THENL 2980 [REWRITE_TAC [CARD_DEF,INTER_EMPTY,LESS_EQ_REFL], 2981 PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN 2982 GEN_TAC THEN COND_CASES_TAC THENL 2983 [IMP_RES_THEN (ASSUME_TAC o SPEC (���t:'a set���)) INTER_FINITE THEN 2984 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [IN_INTER,lemma1], 2985 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [lemma2]]]); 2986 2987val CARD_UNION = 2988 store_thm 2989 ("CARD_UNION", 2990 (���!s:'a set. 2991 FINITE s ==> 2992 !t. FINITE t ==> 2993 (CARD (s UNION t) + CARD (s INTER t) = CARD s + CARD t)���), 2994 SET_INDUCT_TAC THENL 2995 [REWRITE_TAC [UNION_EMPTY,INTER_EMPTY,CARD_DEF,ADD_CLAUSES], 2996 REPEAT STRIP_TAC THEN REWRITE_TAC [INSERT_UNION,INSERT_INTER] THEN 2997 ASM_CASES_TAC (���(e:'a) IN t���) THENL 2998 [IMP_RES_THEN (ASSUME_TAC o SPEC (���t:'a set���)) INTER_FINITE THEN 2999 IMP_RES_TAC CARD_DEF THEN RES_TAC THEN 3000 ASM_REWRITE_TAC [IN_INTER,ADD_CLAUSES], 3001 IMP_RES_TAC UNION_FINITE THEN 3002 IMP_RES_TAC CARD_DEF THEN RES_TAC THEN 3003 ASM_REWRITE_TAC [ADD_CLAUSES, INV_SUC_EQ, IN_UNION]]]); 3004 3005val CARD_UNION_EQN = store_thm( 3006 "CARD_UNION_EQN", 3007 ``!s:'a set t. 3008 FINITE s /\ FINITE t ==> 3009 (CARD (s UNION t) = CARD s + CARD t - CARD (s INTER t))``, 3010 REPEAT STRIP_TAC THEN 3011 `CARD (s INTER t) <= CARD s` 3012 by SRW_TAC [][CARD_INTER_LESS_EQ] THEN 3013 `CARD (s INTER t) <= CARD s + CARD t` by SRW_TAC [ARITH_ss][] THEN 3014 SRW_TAC [][GSYM ADD_EQ_SUB, CARD_UNION]); 3015 3016val lemma = 3017 TAC_PROOF 3018 (([], (���!n m. (n <= SUC m) = (n <= m \/ (n = SUC m))���)), 3019 REWRITE_TAC [LESS_OR_EQ,LESS_THM] THEN 3020 REPEAT (STRIP_TAC ORELSE EQ_TAC) THEN ASM_REWRITE_TAC[]); 3021 3022val CARD_SUBSET = 3023 store_thm 3024 ("CARD_SUBSET", 3025 (���!s:'a set. 3026 FINITE s ==> !t. t SUBSET s ==> CARD t <= CARD s���), 3027 SET_INDUCT_TAC THENL 3028 [REWRITE_TAC [SUBSET_EMPTY,CARD_EMPTY] THEN 3029 GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN 3030 REWRITE_TAC [CARD_DEF,LESS_EQ_REFL], 3031 IMP_RES_THEN (ASSUME_TAC o SPEC (���e:'a���)) FINITE_INSERT THEN 3032 IMP_RES_TAC CARD_INSERT THEN 3033 ASM_REWRITE_TAC [SUBSET_INSERT_DELETE] THEN 3034 REPEAT STRIP_TAC THEN RES_THEN MP_TAC THEN 3035 IMP_RES_TAC SUBSET_FINITE THEN 3036 IMP_RES_TAC DELETE_FINITE THEN 3037 IMP_RES_TAC CARD_DELETE THEN 3038 ASM_REWRITE_TAC [] THEN COND_CASES_TAC THENL 3039 [let val th = SPEC (���CARD (t:'a set)���) num_CASES 3040 in REPEAT_TCL STRIP_THM_THEN SUBST_ALL_TAC th 3041 end THENL 3042 [REWRITE_TAC [LESS_OR_EQ,LESS_0], 3043 REWRITE_TAC [SUC_SUB1,LESS_OR_EQ,LESS_MONO_EQ,INV_SUC_EQ]], 3044 STRIP_TAC THEN ASM_REWRITE_TAC [lemma]]]); 3045 3046val CARD_PSUBSET = 3047 store_thm 3048 ("CARD_PSUBSET", 3049 (���!s:'a set. 3050 FINITE s ==> !t. t PSUBSET s ==> CARD t < CARD s���), 3051 REPEAT STRIP_TAC THEN IMP_RES_TAC PSUBSET_DEF THEN 3052 IMP_RES_THEN (IMP_RES_THEN MP_TAC) CARD_SUBSET THEN 3053 PURE_ONCE_REWRITE_TAC [LESS_OR_EQ] THEN 3054 DISCH_THEN (STRIP_THM_THEN 3055 (fn th => fn g => ACCEPT_TAC th g handle _ => MP_TAC th g)) THEN 3056 IMP_RES_THEN STRIP_ASSUME_TAC PSUBSET_INSERT_SUBSET THEN 3057 IMP_RES_THEN (IMP_RES_THEN MP_TAC) CARD_SUBSET THEN 3058 IMP_RES_TAC INSERT_SUBSET THEN 3059 IMP_RES_TAC SUBSET_FINITE THEN 3060 IMP_RES_TAC CARD_INSERT THEN 3061 ASM_REWRITE_TAC [LESS_EQ] THEN 3062 REPEAT STRIP_TAC THEN FIRST_ASSUM ACCEPT_TAC); 3063 3064val SUBSET_EQ_CARD = Q.store_thm 3065("SUBSET_EQ_CARD", 3066 `!s. FINITE s ==> !t. FINITE t /\ (CARD s = CARD t) /\ s SUBSET t ==> (s=t)`, 3067SET_INDUCT_TAC THEN RW_TAC bool_ss [EXTENSION] THENL 3068[PROVE_TAC [CARD_DEF, CARD_EQ_0], ALL_TAC] THEN 3069 EQ_TAC THEN RW_TAC bool_ss [] THENL 3070 [FULL_SIMP_TAC bool_ss [SUBSET_DEF], ALL_TAC] THEN 3071 Q.PAT_X_ASSUM `!t. FINITE t /\ (CARD s = CARD t) /\ s SUBSET t ==> (s = t)` 3072 (MP_TAC o Q.SPEC `t DELETE e`) THEN 3073 RW_TAC arith_ss [FINITE_DELETE, CARD_DELETE, SUBSET_DELETE] THENL 3074 [ALL_TAC, FULL_SIMP_TAC bool_ss [INSERT_SUBSET]] THEN 3075 `CARD t = SUC (CARD s)` by PROVE_TAC [CARD_INSERT] THEN 3076 `s SUBSET t` by FULL_SIMP_TAC bool_ss [INSERT_SUBSET] THEN 3077 FULL_SIMP_TAC arith_ss [] THEN 3078 RW_TAC bool_ss [INSERT_DEF, DELETE_DEF, GSPECIFICATION,IN_DIFF,NOT_IN_EMPTY]); 3079 3080val CARD_SING = 3081 store_thm 3082 ("CARD_SING", 3083 (���!x:'a. CARD {x} = 1���), 3084 CONV_TAC (ONCE_DEPTH_CONV num_CONV) THEN 3085 GEN_TAC THEN ASSUME_TAC FINITE_EMPTY THEN 3086 IMP_RES_THEN (ASSUME_TAC o SPEC (���x:'a���)) FINITE_INSERT THEN 3087 IMP_RES_TAC CARD_DEF THEN ASM_REWRITE_TAC [NOT_IN_EMPTY,CARD_DEF]); 3088 3089Theorem SING_IFF_CARD1: 3090 !s:'a set. SING s <=> CARD s = 1 /\ FINITE s 3091Proof 3092 REWRITE_TAC [SING_DEF,ONE] THEN 3093 GEN_TAC THEN EQ_TAC THENL 3094 [DISCH_THEN (CHOOSE_THEN SUBST1_TAC) THEN 3095 CONJ_TAC THENL 3096 [ASSUME_TAC FINITE_EMPTY THEN 3097 IMP_RES_TAC CARD_INSERT THEN 3098 ASM_REWRITE_TAC [CARD_EMPTY,NOT_IN_EMPTY], 3099 REWRITE_TAC [FINITE_INSERT,FINITE_EMPTY]], 3100 STRIP_ASSUME_TAC (SPEC (���s:'a set���) SET_CASES) THENL 3101 [ASM_REWRITE_TAC [CARD_EMPTY,NOT_EQ_SYM(SPEC_ALL NOT_SUC)], 3102 ASM_REWRITE_TAC [FINITE_INSERT] THEN 3103 DISCH_THEN (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN 3104 IMP_RES_TAC CARD_INSERT THEN 3105 IMP_RES_TAC CARD_EQ_0 THEN 3106 ASM_REWRITE_TAC [INV_SUC_EQ] THEN 3107 DISCH_TAC THEN EXISTS_TAC (���x:'a���) THEN 3108 ASM_REWRITE_TAC []]] 3109QED 3110 3111(* ---------------------------------------------------------------------*) 3112(* A theorem from homeier@aero.uniblab (Peter Homeier) *) 3113(* ---------------------------------------------------------------------*) 3114val CARD_DIFF = 3115 store_thm 3116 ("CARD_DIFF", 3117 (���!t:'a set. 3118 FINITE t ==> 3119 !s:'a set. FINITE s ==> 3120 (CARD (s DIFF t) = (CARD s - CARD (s INTER t)))���), 3121 SET_INDUCT_TAC THEN REPEAT STRIP_TAC THENL 3122 [REWRITE_TAC [DIFF_EMPTY,INTER_EMPTY,CARD_EMPTY,SUB_0], 3123 PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN 3124 PURE_ONCE_REWRITE_TAC [INSERT_INTER] THEN 3125 COND_CASES_TAC THENL 3126 [let val th = SPEC (���s':'a set���) 3127 (UNDISCH (SPEC (���s:'a set���) INTER_FINITE)) 3128 in PURE_ONCE_REWRITE_TAC [MATCH_MP CARD_INSERT th] 3129 end THEN 3130 IMP_RES_THEN (ASSUME_TAC o SPEC (���e:'a���)) FINITE_DELETE THEN 3131 IMP_RES_TAC CARD_DELETE THEN 3132 RES_TAC THEN ASM_REWRITE_TAC [IN_INTER,DIFF_INSERT] THEN 3133 PURE_ONCE_REWRITE_TAC [SYM (SPEC_ALL SUB_PLUS)] THEN 3134 REWRITE_TAC [ONE,ADD_CLAUSES,DELETE_INTER] THEN 3135 MP_TAC (SPECL [(���s':'a set���),(���s:'a set���),(���e:'a���)] 3136 IN_INTER) THEN 3137 ASM_REWRITE_TAC [DELETE_NON_ELEMENT] THEN 3138 DISCH_THEN SUBST1_TAC THEN 3139 SUBST1_TAC (SPECL [(���s:'a set���),(���s':'a set���)] INTER_COMM) 3140 THEN REFL_TAC, 3141 IMP_RES_TAC DELETE_NON_ELEMENT THEN 3142 PURE_ONCE_REWRITE_TAC [INTER_COMM] THEN 3143 RES_TAC THEN ASM_REWRITE_TAC [DIFF_INSERT]]]); 3144 3145(* Improved version of the above - DIFF's second argument can be infinite *) 3146Theorem CARD_DIFF_EQN : 3147 !t s. FINITE s ==> (CARD (s DIFF t) = CARD s - CARD (s INTER t)) 3148Proof 3149 GEN_TAC THEN 3150 Induct_on `FINITE` THEN SRW_TAC [][] THEN 3151 Cases_on `e IN t` THEN 3152 SRW_TAC [][INSERT_INTER, INSERT_DIFF, INTER_FINITE] THEN 3153 `CARD (s INTER t) <= CARD s` 3154 by METIS_TAC [CARD_INTER_LESS_EQ] THEN 3155 SRW_TAC [numSimps.ARITH_ss][] 3156QED 3157 3158(* ---------------------------------------------------------------------*) 3159(* A theorem from homeier@aero.uniblab (Peter Homeier) *) 3160(* ---------------------------------------------------------------------*) 3161val LESS_CARD_DIFF = 3162 store_thm 3163 ("LESS_CARD_DIFF", 3164 (���!t:'a set. FINITE t ==> 3165 !s. FINITE s ==> (CARD t < CARD s) ==> (0 < CARD(s DIFF t))���), 3166 REPEAT STRIP_TAC THEN 3167 REPEAT_GTCL IMP_RES_THEN SUBST1_TAC CARD_DIFF THEN 3168 PURE_REWRITE_TAC [GSYM SUB_LESS_0] THEN 3169 let val th1 = UNDISCH (SPEC (���s:'a set���) CARD_INTER_LESS_EQ) 3170 val th2 = SPEC (���t:'a set���) 3171 (PURE_ONCE_REWRITE_RULE [LESS_OR_EQ] th1) 3172 in DISJ_CASES_THEN2 ACCEPT_TAC (SUBST_ALL_TAC o SYM) th2 3173 end THEN 3174 let val th3 = SPEC (���s:'a set���) 3175 (UNDISCH(SPEC(���t:'a set���) CARD_INTER_LESS_EQ)) 3176 val th4 = PURE_ONCE_REWRITE_RULE [INTER_COMM] th3 3177 in 3178 IMP_RES_TAC (PURE_ONCE_REWRITE_RULE [GSYM NOT_LESS] th4) 3179 end); 3180 3181Theorem BIJ_FINITE: 3182 !f s t. BIJ f s t /\ FINITE s ==> FINITE t 3183Proof 3184 Induct_on `FINITE s` THEN SRW_TAC[][BIJ_EMPTY, BIJ_INSERT] THEN 3185 METIS_TAC [FINITE_DELETE] 3186QED 3187 3188Theorem BIJ_FINITE_SUBSET: 3189 !(f : num -> 'a) s t. 3190 BIJ f UNIV s /\ FINITE t /\ t SUBSET s ==> 3191 ?N. !n. N <= n ==> ~(f n IN t) 3192Proof 3193 Induct_on ���FINITE��� 3194 >> RW_TAC std_ss [EMPTY_SUBSET, NOT_IN_EMPTY, INSERT_SUBSET, IN_INSERT] 3195 >> Know `?!k. f k = e` 3196 >- ( Q.PAT_X_ASSUM `BIJ a b c` MP_TAC \\ 3197 RW_TAC std_ss [BIJ_ALT] \\ 3198 ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:num``] IN_UNIV) \\ 3199 PROVE_TAC [] ) 3200 >> CONV_TAC (DEPTH_CONV EXISTS_UNIQUE_CONV) 3201 >> RW_TAC std_ss [] 3202 >> RES_TAC 3203 >> Q.EXISTS_TAC `MAX N (SUC k)` 3204 >> `!m n k. MAX m n <= k <=> m <= k /\ n <= k` by RW_TAC arith_ss [MAX_DEF] 3205 >> RW_TAC std_ss [] 3206 >> STRIP_TAC 3207 >> Know `n = k` >- PROVE_TAC [] 3208 >> DECIDE_TAC 3209QED 3210 3211Theorem FINITE_BIJ: 3212 !f s t. FINITE s /\ BIJ f s t ==> FINITE t /\ (CARD s = CARD t) 3213Proof 3214 Induct_on ���FINITE��� 3215 >> CONJ_TAC 3216 >- ( RW_TAC std_ss [BIJ_ALT, FINITE_EMPTY, CARD_EMPTY, IN_FUNSET, NOT_IN_EMPTY, 3217 EXISTS_UNIQUE_ALT] \\ (* 2 sub-goals here, same tacticals *) 3218 FULL_SIMP_TAC std_ss [NOT_IN_EMPTY] \\ 3219 `t = {}` by RW_TAC std_ss [EXTENSION, NOT_IN_EMPTY] \\ 3220 RW_TAC std_ss [FINITE_EMPTY, CARD_EMPTY] ) 3221 >> NTAC 7 STRIP_TAC 3222 >> MP_TAC (Q.SPECL [`f`, `e`, `s`, `t`] BIJ_INSERT_IMP) 3223 >> ASM_REWRITE_TAC [] 3224 >> STRIP_TAC 3225 >> Know `FINITE u` >- PROVE_TAC [] 3226 >> STRIP_TAC 3227 >> CONJ_TAC >- PROVE_TAC [FINITE_INSERT] 3228 >> Q.PAT_X_ASSUM `f e INSERT u = t` (fn th => RW_TAC std_ss [SYM th]) 3229 >> RW_TAC std_ss [CARD_INSERT] 3230 >> PROVE_TAC [] 3231QED 3232 3233val FINITE_BIJ_CARD = store_thm 3234 ("FINITE_BIJ_CARD", 3235 ``!f s t. FINITE s /\ BIJ f s t ==> (CARD s = CARD t)``, 3236 PROVE_TAC [FINITE_BIJ]); 3237 3238val FINITE_BIJ_CARD_EQ = Q.store_thm 3239("FINITE_BIJ_CARD_EQ", 3240 `!S. FINITE S ==> !t f. BIJ f S t /\ FINITE t ==> (CARD S = CARD t)`, 3241SET_INDUCT_TAC THEN RW_TAC bool_ss [BIJ_EMPTY, CARD_EMPTY] THEN 3242`BIJ f s (t DELETE (f e))` by 3243 METIS_TAC [DELETE_NON_ELEMENT, IN_INSERT, DELETE_INSERT, BIJ_DELETE] THEN 3244RW_TAC bool_ss [CARD_INSERT] THEN 3245Q.PAT_X_ASSUM `$! m` (MP_TAC o Q.SPECL [`t DELETE f e`, `f`]) THEN 3246RW_TAC bool_ss [FINITE_DELETE] THEN 3247`f e IN t` by (Q.PAT_X_ASSUM `BIJ f (e INSERT s) t` MP_TAC THEN 3248 RW_TAC (bool_ss++SET_SPEC_ss) [BIJ_DEF,INJ_DEF,INSERT_DEF]) THEN 3249RW_TAC arith_ss [CARD_DELETE] THEN 3250`~(CARD t = 0)` by METIS_TAC [EMPTY_DEF, IN_DEF, CARD_EQ_0] THEN 3251RW_TAC arith_ss []); 3252 3253Theorem CARD_INJ_IMAGE: 3254 !f s. (!x y. (f x = f y) <=> (x = y)) /\ FINITE s ==> 3255 (CARD (IMAGE f s) = CARD s) 3256Proof 3257 Induct_on ���FINITE��� >> SRW_TAC[][] 3258QED 3259 3260val CARD_IMAGE = store_thm("CARD_IMAGE", 3261 ``!s. FINITE s ==> (CARD (IMAGE f s) <= CARD s)``, 3262 SET_INDUCT_TAC THEN 3263 ASM_SIMP_TAC bool_ss [CARD_DEF, IMAGE_INSERT, IMAGE_FINITE, 3264 IMAGE_EMPTY, ZERO_LESS_EQ] THEN 3265 COND_CASES_TAC THEN ASM_SIMP_TAC arith_ss []) ; 3266 3267val SURJ_CARD = Q.store_thm ("SURJ_CARD", 3268 `!s. FINITE s ==> !t. SURJ f s t ==> FINITE t /\ CARD t <= CARD s`, 3269 REWRITE_TAC [IMAGE_SURJ] THEN REPEAT STRIP_TAC THEN 3270 BasicProvers.VAR_EQ_TAC THENL 3271 [irule IMAGE_FINITE, irule CARD_IMAGE] THEN 3272 FIRST_ASSUM ACCEPT_TAC) ; 3273 3274val FINITE_SURJ = Q.store_thm("FINITE_SURJ", 3275 `FINITE s /\ SURJ f s t ==> FINITE t`, 3276 SRW_TAC[][] THEN IMP_RES_TAC SURJ_INJ_INV THEN IMP_RES_TAC FINITE_INJ); 3277 3278val FINITE_SURJ_BIJ = Q.store_thm("FINITE_SURJ_BIJ", 3279 `FINITE s /\ SURJ f s t /\ (CARD t = CARD s) ==> BIJ f s t`, 3280 SRW_TAC[][BIJ_DEF,INJ_DEF] >- fs[SURJ_DEF] 3281 \\ CCONTR_TAC 3282 \\ `SURJ f (s DELETE x) t` by (fs[SURJ_DEF] \\ METIS_TAC[]) 3283 \\ `FINITE (s DELETE x)` by METIS_TAC[FINITE_DELETE] 3284 \\ IMP_RES_TAC SURJ_CARD 3285 \\ REV_FULL_SIMP_TAC (srw_ss()) [CARD_DELETE] 3286 \\ Cases_on`CARD s` \\ REV_FULL_SIMP_TAC (srw_ss())[CARD_EQ_0] >> fs[]); 3287 3288val FINITE_COMPLETE_INDUCTION = Q.store_thm( 3289 "FINITE_COMPLETE_INDUCTION", 3290 `!P. (!x. (!y. y PSUBSET x ==> P y) ==> FINITE x ==> P x) 3291 ==> 3292 !x. FINITE x ==> P x`, 3293 GEN_TAC THEN STRIP_TAC THEN 3294 MATCH_MP_TAC ((BETA_RULE o 3295 Q.ISPEC `\x. FINITE x ==> P x` o 3296 REWRITE_RULE [prim_recTheory.WF_measure] o 3297 Q.ISPEC `measure CARD`) 3298 relationTheory.WF_INDUCTION_THM) THEN 3299 REPEAT STRIP_TAC THEN 3300 RULE_ASSUM_TAC (REWRITE_RULE [AND_IMP_INTRO]) THEN 3301 Q.PAT_X_ASSUM `!x. (!y. y PSUBSET x ==> P y) /\ FINITE x ==> 3302 P x` MATCH_MP_TAC THEN 3303 ASM_REWRITE_TAC [] THEN REPEAT STRIP_TAC THEN 3304 FIRST_X_ASSUM MATCH_MP_TAC THEN 3305 ASM_REWRITE_TAC [prim_recTheory.measure_def, 3306 relationTheory.inv_image_def] THEN 3307 BETA_TAC THEN mesonLib.ASM_MESON_TAC [PSUBSET_FINITE, CARD_PSUBSET]); 3308 3309val CARD_INSERT' = SPEC_ALL (UNDISCH (SPEC_ALL CARD_INSERT)) ; 3310 3311val INJ_CARD_IMAGE = Q.store_thm ("INJ_CARD_IMAGE", 3312 `!s. FINITE s ==> INJ f s t ==> (CARD (IMAGE f s) = CARD s)`, 3313 HO_MATCH_MP_TAC FINITE_INDUCT THEN 3314 REWRITE_TAC [IMAGE_EMPTY, CARD_EMPTY, IMAGE_INSERT] THEN 3315 REPEAT STRIP_TAC THEN 3316 VALIDATE (CONV_TAC (DEPTH_CONV (REWR_CONV_A CARD_INSERT'))) THEN1 3317 (irule IMAGE_FINITE THEN FIRST_ASSUM ACCEPT_TAC) THEN 3318 ASM_REWRITE_TAC [IN_IMAGE] THEN 3319 RULE_L_ASSUM_TAC (CONJUNCTS o REWRITE_RULE [INJ_INSERT]) THEN 3320 REVERSE COND_CASES_TAC THEN1 3321 (RES_TAC THEN ASM_REWRITE_TAC [INV_SUC_EQ]) THEN 3322 FIRST_X_ASSUM CHOOSE_TAC THEN 3323 RULE_L_ASSUM_TAC CONJUNCTS THEN RES_TAC THEN 3324 BasicProvers.VAR_EQ_TAC THEN FULL_SIMP_TAC std_ss []) ; 3325 3326val INJ_CARD = Q.store_thm 3327("INJ_CARD", 3328 `!(f:'a->'b) s t. INJ f s t /\ FINITE t ==> CARD s <= CARD t`, 3329 REPEAT GEN_TAC THEN 3330 DISCH_THEN (fn th => ASSUME_TAC (MATCH_MP FINITE_INJ th) THEN 3331 ASSUME_TAC (CONJUNCT1 th) THEN 3332 IMP_RES_TAC (GSYM INJ_CARD_IMAGE) THEN 3333 ASSUME_TAC (CONJUNCT2 th)) THEN 3334 ASM_REWRITE_TAC [] THEN 3335 irule CARD_SUBSET THEN CONJ_TAC THEN1 FIRST_ASSUM ACCEPT_TAC THEN 3336 IMP_RES_TAC INJ_IMAGE_SUBSET) ; 3337 3338val PHP = Q.store_thm 3339("PHP", 3340 `!(f:'a->'b) s t. FINITE t /\ CARD t < CARD s ==> ~INJ f s t`, 3341 METIS_TAC [INJ_CARD, AP ``x < y <=> ~(y <= x)``]); 3342 3343val INJ_CARD_IMAGE_EQ = Q.store_thm ("INJ_CARD_IMAGE_EQ", 3344 `INJ f s t ==> FINITE s ==> (CARD (IMAGE f s) = CARD s)`, 3345 REPEAT STRIP_TAC THEN IMP_RES_TAC INJ_CARD_IMAGE) ; 3346 3347(* ------------------------------------------------------------------------- *) 3348(* Relational form of CARD (from cardinalTheory) *) 3349(* ------------------------------------------------------------------------- *) 3350 3351val _ = set_fixity "HAS_SIZE" (Infix(NONASSOC, 450)); 3352 3353val HAS_SIZE = new_definition ("HAS_SIZE", 3354 ���s HAS_SIZE n <=> FINITE s /\ (CARD s = n)���); 3355 3356Theorem HAS_SIZE_CARD : 3357 !s n. s HAS_SIZE n ==> (CARD s = n) 3358Proof 3359 SIMP_TAC std_ss [HAS_SIZE] 3360QED 3361 3362Theorem HAS_SIZE_0: 3363 !(s:'a->bool). s HAS_SIZE 0:num <=> (s = {}) 3364Proof 3365 simp [HAS_SIZE, EQ_IMP_THM] 3366 >> ���!s. FINITE s ==> (CARD s = 0 ==> s = {})��� suffices_by (METIS_TAC []) 3367 >> Induct_on ���FINITE��� >> simp [] 3368QED 3369 3370Theorem HAS_SIZE_SUC : 3371 !(s:'a->bool) n. s HAS_SIZE (SUC n) <=> 3372 s <> {} /\ !a. a IN s ==> (s DELETE a) HAS_SIZE n 3373Proof 3374 rpt GEN_TAC THEN REWRITE_TAC[HAS_SIZE] 3375 >> ASM_CASES_TAC ``s:'a->bool = {}`` 3376 >> ASM_REWRITE_TAC [CARD_DEF, FINITE_EMPTY, FINITE_INSERT, 3377 NOT_IN_EMPTY, SUC_NOT] 3378 >> REWRITE_TAC [FINITE_DELETE] 3379 >> ASM_CASES_TAC ``FINITE(s:'a->bool)`` 3380 >> RW_TAC std_ss [NOT_FORALL_THM, MEMBER_NOT_EMPTY] 3381 >> EQ_TAC >> rpt STRIP_TAC 3382 >| [ ASM_SIMP_TAC std_ss [CARD_DELETE], 3383 KNOW_TAC ``?x. x IN s`` THENL 3384 [ FULL_SIMP_TAC std_ss [MEMBER_NOT_EMPTY], ALL_TAC] \\ 3385 DISCH_THEN (X_CHOOSE_TAC ``a:'a``) \\ 3386 ASSUME_TAC CARD_INSERT \\ 3387 POP_ASSUM (MP_TAC o Q.SPEC `s DELETE a`) \\ 3388 FULL_SIMP_TAC std_ss [FINITE_DELETE] >> STRIP_TAC \\ 3389 POP_ASSUM (MP_TAC o Q.SPEC `a`) \\ 3390 FULL_SIMP_TAC std_ss [INSERT_DELETE] \\ 3391 ASM_REWRITE_TAC [IN_DELETE] ] 3392QED 3393 3394Theorem FINITE_HAS_SIZE : 3395 !s. FINITE s <=> s HAS_SIZE CARD s 3396Proof 3397 REWRITE_TAC [HAS_SIZE] 3398QED 3399 3400(* ====================================================================== *) 3401(* Sets of size n. *) 3402(* ====================================================================== *) 3403 3404val count_def = new_definition ("count_def", ``count (n:num) = {m | m < n}``); 3405 3406Theorem IN_COUNT[simp]: 3407 !m n. m IN count n <=> m < n 3408Proof 3409 RW_TAC bool_ss [GSPECIFICATION, count_def] 3410QED 3411 3412val COUNT_ZERO = store_thm 3413 ("COUNT_ZERO", 3414 ``count 0 = {}``, 3415 RW_TAC bool_ss [EXTENSION, IN_COUNT, NOT_IN_EMPTY] 3416 THEN CONV_TAC Arith.ARITH_CONV); 3417val _ = export_rewrites ["COUNT_ZERO"] 3418 3419val COUNT_SUC = store_thm 3420 ("COUNT_SUC", 3421 ``!n. count (SUC n) = n INSERT count n``, 3422 RW_TAC bool_ss [EXTENSION, IN_INSERT, IN_COUNT] 3423 THEN CONV_TAC Arith.ARITH_CONV); 3424 3425val FINITE_COUNT = store_thm 3426 ("FINITE_COUNT", 3427 ``!n. FINITE (count n)``, 3428 Induct THENL 3429 [RW_TAC bool_ss [COUNT_ZERO, FINITE_EMPTY], 3430 RW_TAC bool_ss [COUNT_SUC, FINITE_INSERT]]); 3431val _ = export_rewrites ["FINITE_COUNT"] 3432 3433val CARD_COUNT = store_thm 3434 ("CARD_COUNT", 3435 ``!n. CARD (count n) = n``, 3436 Induct THENL 3437 [RW_TAC bool_ss [COUNT_ZERO, CARD_EMPTY], 3438 RW_TAC bool_ss [COUNT_SUC, CARD_INSERT, FINITE_COUNT, IN_COUNT] 3439 THEN POP_ASSUM MP_TAC 3440 THEN CONV_TAC Arith.ARITH_CONV]); 3441val _ = export_rewrites ["CARD_COUNT"] 3442 3443val COUNT_11 = store_thm 3444 ("COUNT_11", ``!n1 n2. (count n1 = count n2) <=> (n1 = n2)``, 3445 SRW_TAC [] [EQ_IMP_THM, EXTENSION] 3446 >> METIS_TAC [numLib.ARITH_PROVE ``x:num < y <=> ~(y <= x)``, 3447 LESS_EQ_REFL, LESS_EQUAL_ANTISYM]); 3448val _ = export_rewrites ["COUNT_11"]; 3449 3450val COUNT_DELETE = store_thm (* from measureTheory *) 3451 ("COUNT_DELETE", ``!n. count n DELETE n = count n``, 3452 SRW_TAC [] [EQ_IMP_THM, EXTENSION]); 3453val _ = export_rewrites ["COUNT_DELETE"]; 3454 3455val COUNT_MONO = store_thm (* from extrealTheory *) 3456 ("COUNT_MONO", ``!m n. m <= n ==> (count m) SUBSET (count n)``, 3457 SRW_TAC [] [count_def, SUBSET_DEF, GSPECIFICATION] 3458 >> RW_TAC arith_ss []); 3459 3460val COUNT_NOT_EMPTY = store_thm (* from probabilityTheory *) 3461 ("COUNT_NOT_EMPTY", ``!n. 0 < n <=> count n <> {}``, 3462 RW_TAC arith_ss [Once EXTENSION, IN_COUNT, NOT_IN_EMPTY] 3463 >> EQ_TAC >> STRIP_TAC 3464 >- (Q.EXISTS_TAC `0` >> ASM_REWRITE_TAC []) 3465 >> `0 <= x` by RW_TAC arith_ss [] 3466 >> MATCH_MP_TAC LESS_EQ_LESS_TRANS 3467 >> Q.EXISTS_TAC `x` >> ASM_REWRITE_TAC []); 3468 3469(* =====================================================================*) 3470(* Infiniteness *) 3471(* =====================================================================*) 3472 3473val _ = overload_on ("INFINITE", ``\s. ~FINITE s``) 3474 3475val NOT_IN_FINITE = 3476 store_thm 3477 ("NOT_IN_FINITE", 3478 (���INFINITE (UNIV:'a set) 3479 = 3480 !s:'a set. FINITE s ==> ?x. ~(x IN s)���), 3481 EQ_TAC THENL 3482 [CONV_TAC CONTRAPOS_CONV THEN 3483 CONV_TAC (ONCE_DEPTH_CONV NOT_FORALL_CONV) THEN 3484 REWRITE_TAC [NOT_IMP] THEN 3485 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN 3486 REWRITE_TAC [EQ_UNIV] THEN 3487 CONV_TAC (ONCE_DEPTH_CONV SYM_CONV) THEN 3488 REPEAT STRIP_TAC THEN ASM_REWRITE_TAC [], 3489 REPEAT STRIP_TAC THEN RES_THEN STRIP_ASSUME_TAC THEN 3490 ASSUME_TAC (SPEC (���x:'a���) IN_UNIV) THEN RES_TAC]); 3491 3492val INFINITE_INHAB = Q.store_thm 3493("INFINITE_INHAB", 3494 `!P. INFINITE P ==> ?x. x IN P`, 3495 REWRITE_TAC [MEMBER_NOT_EMPTY] THEN REPEAT STRIP_TAC THEN 3496 FIRST_X_ASSUM SUBST_ALL_TAC THEN POP_ASSUM MP_TAC THEN 3497 REWRITE_TAC [FINITE_EMPTY]); 3498 3499val INVERSE_LEMMA = 3500 TAC_PROOF 3501 (([], (���!f:'a->'b. (!x y. (f x = f y) ==> (x = y)) ==> 3502 ((\x:'b. @y:'a. x = f y) o f = \x:'a.x)���)), 3503 REPEAT STRIP_TAC THEN CONV_TAC FUN_EQ_CONV THEN 3504 PURE_ONCE_REWRITE_TAC [o_THM] THEN 3505 CONV_TAC (ONCE_DEPTH_CONV BETA_CONV) THEN 3506 GEN_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN 3507 CONV_TAC (SYM_CONV THENC SELECT_CONV) THEN 3508 EXISTS_TAC (���x:'a���) THEN REFL_TAC); 3509 3510val IMAGE_11_INFINITE = store_thm ( 3511 "IMAGE_11_INFINITE", 3512 ``!f:'a->'b. (!x y. (f x = f y) ==> (x = y)) ==> 3513 !s:'a set. INFINITE s ==> INFINITE (IMAGE f s)``, 3514 METIS_TAC [INJECTIVE_IMAGE_FINITE]); 3515 3516val INFINITE_SUBSET = 3517 store_thm 3518 ("INFINITE_SUBSET", 3519 (���!s:'a set. INFINITE s ==> (!t. s SUBSET t ==> INFINITE t)���), 3520 REPEAT STRIP_TAC THEN IMP_RES_TAC SUBSET_FINITE THEN RES_TAC); 3521 3522val IN_INFINITE_NOT_FINITE = store_thm ( 3523 "IN_INFINITE_NOT_FINITE", 3524 ``!s t. INFINITE s /\ FINITE t ==> ?x:'a. x IN s /\ ~(x IN t)``, 3525 CONV_TAC (ONCE_DEPTH_CONV CONTRAPOS_CONV) THEN 3526 CONV_TAC (ONCE_DEPTH_CONV NOT_EXISTS_CONV) THEN 3527 PURE_ONCE_REWRITE_TAC [DE_MORGAN_THM] THEN 3528 REWRITE_TAC [SYM(SPEC_ALL IMP_DISJ_THM)] THEN 3529 PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL SUBSET_DEF)] THEN 3530 REPEAT STRIP_TAC THEN IMP_RES_TAC INFINITE_SUBSET); 3531 3532val INFINITE_INJ = store_thm (* from util_prob *) 3533 ("INFINITE_INJ", 3534 ``!f s t. INJ f s t /\ INFINITE s ==> INFINITE t``, 3535 PROVE_TAC [FINITE_INJ]); 3536 3537(* ---------------------------------------------------------------------- *) 3538(* The next series of lemmas are used for proving that if UNIV: set *) 3539(* is INFINITE then :'a satisfies an axiom of infinity. *) 3540(* *) 3541(* The function g:num->'a set defines a series of sets: *) 3542(* *) 3543(* {}, {x1}, {x1,x2}, {x1,x2,x3},... *) 3544(* *) 3545(* and one then defines an f:'a->'a such that f(xi)=xi+1. *) 3546(* ---------------------------------------------------------------------- *) 3547 3548(* ---------------------------------------------------------------------*) 3549(* Defining equations for g *) 3550(* ---------------------------------------------------------------------*) 3551 3552val gdef = map Term 3553 [ `g 0 = ({}:'a set)`, 3554 `!n. g (SUC n) = 3555 case some x. x IN s /\ x NOTIN g n of 3556 NONE => g n 3557 | SOME x => x INSERT g n`] 3558 3559(* ---------------------------------------------------------------------*) 3560(* Lemma: g n is finite for all n. *) 3561(* ---------------------------------------------------------------------*) 3562 3563val optcases = optionTheory.option_CASES 3564val optinfo = {case_def= optionTheory.option_case_def, nchotomy = optcases} 3565val rand_case = prove_case_rand_thm optinfo 3566val optcase_elim = Q.prove( 3567 ���option_CASE optv n fv:bool <=> 3568 (optv = NONE) /\ n \/ ?x. (optv = SOME x) /\ fv x���, 3569 Cases_on `optv` >> simp[]); 3570 3571val g_finite = 3572 TAC_PROOF 3573 ((gdef, ``!n:num. FINITE (g n:'a set)``), 3574 INDUCT_TAC >> simp[rand_case, optcase_elim] >> METIS_TAC[optcases]); 3575 3576(* ---------------------------------------------------------------------*) 3577(* Lemma: g n is contained in g (n+i) for all i. *) 3578(* ---------------------------------------------------------------------*) 3579 3580val g_subset = 3581 TAC_PROOF 3582 ((gdef, ``!n. !x:'a. x IN (g n) ==> !i. x IN (g (n+i))``), 3583 REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN 3584 ASM_REWRITE_TAC [ADD_CLAUSES,IN_INSERT] >> 3585 simp[optcase_elim, rand_case] >> METIS_TAC[optcases]); 3586 3587(* ---------------------------------------------------------------------*) 3588(* Lemma: if x is in g(n) then {x} = g(n+1)-g(n) for some n. *) 3589(* ---------------------------------------------------------------------*) 3590 3591val lemma = 3592 TAC_PROOF(([], (���((A \/ B) /\ ~B) = (A /\ ~B)���)), 3593 BOOL_CASES_TAC (���B:bool���) THEN REWRITE_TAC[]); 3594 3595val g_cases = 3596 TAC_PROOF 3597 ((gdef, (���!x:'a. (?n. x IN (g n)) ==> 3598 (?m. (x IN (g (SUC m))) /\ ~(x IN (g m)))���)), 3599 GEN_TAC >> 3600 DISCH_THEN (STRIP_THM_THEN MP_TAC o 3601 CONV_RULE numLib.EXISTS_LEAST_CONV) >> 3602 Cases_on ���n��� >- simp[] >> Q.RENAME_TAC [���x IN g (SUC N)���] >> 3603 STRIP_TAC >> Q.EXISTS_TAC ���N��� >> conj_tac >- first_assum ACCEPT_TAC >> 3604 first_x_assum MATCH_MP_TAC >> simp[]); 3605 3606val g_in_s = TAC_PROOF( 3607 (gdef, ���!n:num. g n SUBSET (s:'a set)���), 3608 Induct >> simp[] >> DEEP_INTRO_TAC optionTheory.some_intro >> simp[] >> 3609 SRW_TAC[][INSERT_SUBSET]); 3610 3611val inf = ���INFINITE (s:'a set)��� 3612val infinite_g_grows = TAC_PROOF( 3613 (inf::gdef, ���!n. ?e:'a. e IN g (SUC n) /\ e NOTIN g n���), 3614 rpt strip_tac >> simp[] >> ONCE_REWRITE_TAC [rand_case] >> 3615 simp_tac (srw_ss() ++ boolSimps.DNF_ss) [optcase_elim] >> 3616 simp_tac (srw_ss() ++ boolSimps.CONJ_ss) [] >> 3617 DEEP_INTRO_TAC optionTheory.some_intro >> simp[] >> 3618 METIS_TAC [IN_INFINITE_NOT_FINITE, g_finite]) 3619 3620val enum_exists = infinite_g_grows |> CONV_RULE SKOLEM_CONV 3621val enum_def = subst[���e:num->'a��� |-> ���enum: num -> 'a���] 3622 (enum_exists |> concl |> dest_exists |> #2) 3623 3624val enum_11 = TAC_PROOF( 3625 (enum_def::inf::gdef, ���!m:num n. (enum m:'a = enum n) <=> (m = n)���), 3626 simp[EQ_IMP_THM] >> SPOSE_NOT_THEN strip_assume_tac >> 3627 wlogLib.wlog_tac ���m < n��� [���m���, ���n���] >- METIS_TAC[NOT_LESS, LESS_OR_EQ] >> 3628 `enum m NOTIN g m /\ enum m IN (g (SUC m))` by simp[] >> 3629 ���?i. n = SUC m + i��� by METIS_TAC[LESS_EQ_EXISTS,LESS_OR] >> 3630 ���enum m IN g n��� by METIS_TAC[g_subset] >> METIS_TAC[]) 3631 3632val enum_in_s = TAC_PROOF( 3633 (enum_def::inf::gdef, ���!n:num. enum n : 'a IN s���), 3634 strip_tac >> ���enum n IN g (SUC n)��� by simp[] >> 3635 ���g (SUC n) SUBSET s��� by simp[g_in_s] >> METIS_TAC[SUBSET_DEF]); 3636 3637(* "define" injection *) 3638val inj_def = 3639 ���!x. inj (x:'a) = case some n. enum n = x of 3640 NONE => x 3641 | SOME n => enum (n + 1)��� 3642 3643val result_part1_0 = TAC_PROOF( 3644 (inj_def::enum_def::inf::gdef, ���INJ inj (s:'a set) s /\ ~SURJ inj s s���), 3645 simp_tac (srw_ss()) [INJ_DEF, SURJ_DEF] >> rpt strip_tac 3646 >- (simp[] >> DEEP_INTRO_TAC optionTheory.some_intro >> simp[enum_in_s]) 3647 >- (pop_assum mp_tac >> simp[] >> DEEP_INTRO_TAC optionTheory.some_intro >> 3648 DEEP_INTRO_TAC optionTheory.some_intro >> simp[enum_11]) 3649 >- (disj2_tac >> Q.EXISTS_TAC ���enum 0��� >> conj_tac >- simp[enum_in_s] >> 3650 Q.X_GEN_TAC ���y��� >> Cases_on ���y IN s��� >> simp[] >> 3651 DEEP_INTRO_TAC optionTheory.some_intro >> simp[enum_11])) 3652 3653val gexists = 3654 num_Axiom 3655 |> INST_TYPE [alpha |-> ``:'a set``] 3656 |> SPECL [���EMPTY : 'a set���, 3657 ���\n:num r:'a set. 3658 case some x. x IN s /\ x NOTIN r of 3659 NONE => r 3660 | SOME x => x INSERT r���] 3661 |> SIMP_RULE bool_ss [] 3662 3663val result_part1 = 3664 result_part1_0 3665 |> EXISTS (mk_exists(���inj:'a -> 'a���, concl result_part1_0), ���inj:'a -> 'a���) 3666 |> DISCH inj_def 3667 |> INST [���inj:'a -> 'a��� |-> ���\x:'a. ^(inj_def |> dest_forall |> #2 |> rhs)���] 3668 |> SIMP_RULE bool_ss [] 3669 |> CHOOSE(``enum:num->'a``, enum_exists) 3670 |> itlist PROVE_HYP (CONJUNCTS (ASSUME (list_mk_conj gdef))) 3671 |> CHOOSE(``g:num ->'a set``, gexists) 3672 |> DISCH_ALL 3673 3674val result_part2 = Q.prove( 3675 ���!s. FINITE s ==> !f. INJ f s s ==> SURJ f s s���, 3676 ho_match_mp_tac FINITE_COMPLETE_INDUCTION >> 3677 simp[INJ_IFF, SURJ_DEF] >> 3678 rpt strip_tac >> SPOSE_NOT_THEN strip_assume_tac >> 3679 Q.RENAME_TAC [���x IN s���] >> 3680 Q.ABBREV_TAC ���s0 = s DELETE x��� >> 3681 ���INJ f s s0��� by simp[INJ_DEF, Abbr���s0���] >> 3682 ���FINITE s0��� by simp[Abbr���s0���] >> 3683 ���CARD s0 < CARD s��� suffices_by METIS_TAC[PHP] >> 3684 simp[Abbr���s0���, CARD_DELETE] >> Cases_on ���s��� >> fs[]) 3685 3686(* ---------------------------------------------------------------------*) 3687(* Finally, we can prove the desired theorem. *) 3688(* ---------------------------------------------------------------------*) 3689 3690val INFINITE_INJ_NOT_SURJ = Q.store_thm("INFINITE_INJ_NOT_SURJ", 3691 `!s. INFINITE s <=> ?f. INJ f s s /\ ~SURJ f s s`, 3692 METIS_TAC[result_part1, result_part2]); 3693 3694(* and applying to the UNIV set *) 3695val INFINITE_UNIV = store_thm ( 3696 "INFINITE_UNIV", 3697 ���INFINITE (UNIV:'a set) 3698 = 3699 ?f:'a->'a. (!x y. (f x = f y) ==> (x = y)) /\ (?y. !x. ~(f x = y))���, 3700 3701 simp[INFINITE_INJ_NOT_SURJ, INJ_DEF, SURJ_DEF]); 3702 3703(* a natural consequence *) 3704val INFINITE_NUM_UNIV = store_thm( 3705 "INFINITE_NUM_UNIV", 3706 ``INFINITE univ(:num)``, 3707 REWRITE_TAC [] THEN 3708 SRW_TAC [][INFINITE_UNIV] THEN Q.EXISTS_TAC `SUC` THEN SRW_TAC [][] THEN 3709 Q.EXISTS_TAC `0` THEN SRW_TAC [][]); 3710val _ = export_rewrites ["INFINITE_NUM_UNIV"] 3711 3712val FINITE_PSUBSET_INFINITE = store_thm("FINITE_PSUBSET_INFINITE", 3713(���!s. INFINITE (s:'a set) = 3714 !t. FINITE (t:'a set) ==> ((t SUBSET s) ==> (t PSUBSET s))���), 3715 PURE_REWRITE_TAC [PSUBSET_DEF] THEN 3716 GEN_TAC THEN EQ_TAC THENL 3717 [REPEAT STRIP_TAC THENL 3718 [FIRST_ASSUM ACCEPT_TAC, 3719 FIRST_ASSUM (fn th => fn g => SUBST_ALL_TAC th g handle _ => NO_TAC g) 3720 THEN RES_TAC], 3721 REPEAT STRIP_TAC THEN RES_TAC THEN 3722 ASSUME_TAC (SPEC (���s:'a set���) SUBSET_REFL) THEN 3723 ASSUME_TAC (REFL (���s:'a set���)) THEN RES_TAC]); 3724 3725val FINITE_PSUBSET_UNIV = store_thm("FINITE_PSUBSET_UNIV", 3726(���INFINITE (UNIV:'a set) = !s:'a set. FINITE s ==> s PSUBSET UNIV���), 3727 PURE_ONCE_REWRITE_TAC [FINITE_PSUBSET_INFINITE] THEN 3728 REWRITE_TAC [PSUBSET_DEF,SUBSET_UNIV]); 3729 3730val INFINITE_DIFF_FINITE = store_thm("INFINITE_DIFF_FINITE", 3731 (���!s t. (INFINITE s /\ FINITE t) ==> ~(s DIFF t = ({}:'a set))���), 3732 REPEAT GEN_TAC THEN STRIP_TAC THEN 3733 IMP_RES_TAC IN_INFINITE_NOT_FINITE THEN 3734 REWRITE_TAC [EXTENSION,IN_DIFF,NOT_IN_EMPTY] THEN 3735 CONV_TAC NOT_FORALL_CONV THEN 3736 EXISTS_TAC ���x:'a��� THEN ASM_REWRITE_TAC[]); 3737 3738val FINITE_INDUCT' = 3739 Ho_Rewrite.REWRITE_RULE [PULL_FORALL] FINITE_INDUCT ; 3740 3741val NOT_IN_COUNT = Q.prove (`~ (m IN count m)`, 3742 REWRITE_TAC [IN_COUNT, LESS_REFL]) ; 3743 3744Theorem FINITE_BIJ_COUNT_EQ: 3745 !s. FINITE s = ?c n. BIJ c (count n) s 3746Proof 3747 RW_TAC std_ss [] 3748 >> REVERSE EQ_TAC >- PROVE_TAC [FINITE_COUNT, FINITE_BIJ] 3749 >> Induct_on ���FINITE��� 3750 >> RW_TAC std_ss [BIJ_DEF, INJ_DEF, SURJ_DEF, NOT_IN_EMPTY] 3751 >- (Q.EXISTS_TAC `c` 3752 >> Q.EXISTS_TAC `0` 3753 >> RW_TAC std_ss [COUNT_ZERO, NOT_IN_EMPTY]) 3754 >> Q.EXISTS_TAC `\m. if m = n then e else c m` 3755 >> Q.EXISTS_TAC `SUC n` 3756 >> Know `!x. x IN count n ==> ~(x = n)` 3757 >- RW_TAC arith_ss [IN_COUNT] 3758 >> RW_TAC std_ss [COUNT_SUC, IN_INSERT] 3759 >> PROVE_TAC [] 3760QED 3761 3762val FINITE_BIJ_COUNT = Q.store_thm ("FINITE_BIJ_COUNT", 3763 `!s. FINITE s ==> ?f b. BIJ f (count b) s`, 3764 RW_TAC std_ss [FINITE_BIJ_COUNT_EQ]); 3765 3766fun drop_forall th = if is_forall (concl th) then [] else [th] ; 3767 3768val FINITE_BIJ_CARD_EQ' = 3769 Ho_Rewrite.REWRITE_RULE [PULL_FORALL, AND_IMP_INTRO] FINITE_BIJ_CARD_EQ ; 3770 3771val FINITE_ISO_NUM = 3772 store_thm 3773 ("FINITE_ISO_NUM", 3774 (���!s:'a set. 3775 FINITE s ==> 3776 ?f. (!n m. (n < CARD s /\ m < CARD s) ==> (f n = f m) ==> (n = m)) /\ 3777 (s = {f n | n < CARD s})���), 3778 REPEAT STRIP_TAC THEN 3779 IMP_RES_TAC FINITE_BIJ_COUNT THEN 3780 ASSUME_TAC (Q.SPEC `b` FINITE_COUNT) THEN 3781 IMP_RES_TAC FINITE_BIJ_CARD_EQ' THEN 3782 ASSUME_TAC (Q.ISPECL [`count b`, `s : 'a -> bool`] FINITE_BIJ_CARD_EQ') THEN 3783 RES_TAC THEN Q.EXISTS_TAC `f` THEN 3784 (* omitting next step multiplies proof time by 40! *) 3785 RULE_L_ASSUM_TAC drop_forall THEN 3786 RULE_L_ASSUM_TAC (CONJUNCTS o 3787 REWRITE_RULE [BIJ_DEF, INJ_DEF, SURJ_DEF, IN_COUNT]) THEN 3788 FIRST_ASSUM (fn th => REWRITE_TAC [SYM th, CARD_COUNT]) THEN 3789 CONJ_TAC THEN1 FIRST_ASSUM ACCEPT_TAC THEN 3790 REWRITE_TAC [EXTENSION] THEN 3791 GEN_TAC THEN EQ_TAC 3792 THENL [ 3793 DISCH_TAC THEN RES_TAC THEN 3794 HO_MATCH_MP_TAC IN_GSPEC THEN 3795 Q.EXISTS_TAC `y` THEN ASM_REWRITE_TAC [], 3796 SIMP_TAC std_ss [GSPECIFICATION] THEN 3797 REPEAT STRIP_TAC THEN RES_TAC THEN ASM_REWRITE_TAC [] ]) ; 3798 3799Theorem FINITE_WEAK_ENUMERATE: 3800 !s. FINITE s = ?f b. !e. e IN s <=> ?n. n < b /\ (e = f n) 3801Proof 3802 GEN_TAC THEN EQ_TAC 3803 THENL [ 3804 DISCH_TAC THEN IMP_RES_TAC FINITE_BIJ_COUNT THEN 3805 RULE_L_ASSUM_TAC (CONJUNCTS o 3806 REWRITE_RULE [BIJ_DEF, SURJ_DEF, IN_COUNT]) THEN 3807 Q.EXISTS_TAC `f` THEN Q.EXISTS_TAC `b` THEN 3808 GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN RES_TAC 3809 THENL [Q.EXISTS_TAC `y`, ALL_TAC] THEN ASM_REWRITE_TAC [], 3810 STRIP_TAC THEN irule SUBSET_FINITE THEN 3811 Q.EXISTS_TAC `IMAGE f (count b)` THEN CONJ_TAC 3812 THENL [ irule IMAGE_FINITE THEN irule FINITE_COUNT, 3813 ASM_SIMP_TAC std_ss [IMAGE_DEF, SUBSET_DEF, count_def, 3814 GSPECIFICATION] THEN 3815 REPEAT STRIP_TAC THEN Q.EXISTS_TAC `n` THEN ASM_REWRITE_TAC [] ]] 3816QED 3817 3818val lem = prove( 3819 ``!s R. 3820 FINITE s /\ (!e. e IN s <=> (?y. R e y) \/ (?x. R x e)) /\ 3821 (!n. R (f (SUC n)) (f n)) ==> 3822 ?x. R^+ x x``, 3823 REPEAT STRIP_TAC THEN `!n. f n IN s` by METIS_TAC [] THEN 3824 Cases_on `?n m. (f n = f m) /\ n <> m` THENL [ 3825 POP_ASSUM STRIP_ASSUME_TAC THEN 3826 Cases_on `n < m` THENL [ 3827 ALL_TAC, 3828 `m < n` by DECIDE_TAC 3829 ] THEN 3830 Q.ISPECL_THEN [`inv R^+`, `f`] MP_TAC transitive_monotone THEN 3831 SRW_TAC [][relationTheory.inv_DEF, relationTheory.transitive_inv] THEN 3832 METIS_TAC [relationTheory.TC_SUBSET], 3833 3834 `!n m. (f n = f m) = (n = m)` by METIS_TAC [] THEN 3835 `IMAGE f univ(:num) SUBSET s` 3836 by (SRW_TAC [][SUBSET_DEF, IN_IMAGE] THEN METIS_TAC []) THEN 3837 `FINITE (IMAGE f univ(:num))` by METIS_TAC [SUBSET_FINITE] THEN 3838 POP_ASSUM MP_TAC THEN SRW_TAC [][INJECTIVE_IMAGE_FINITE] 3839 ]) 3840 3841val FINITE_WF_noloops = store_thm( 3842 "FINITE_WF_noloops", 3843 ``!s. FINITE s ==> 3844 (WF (REL_RESTRICT R s) <=> irreflexive (REL_RESTRICT R s)^+)``, 3845 Q_TAC SUFF_TAC 3846 `!s. FINITE s ==> 3847 irreflexive (TC (REL_RESTRICT R s)) ==> WF (REL_RESTRICT R s)` 3848 THEN1 METIS_TAC [relationTheory.irreflexive_def, 3849 relationTheory.WF_noloops] THEN 3850 REWRITE_TAC [prim_recTheory.WF_IFF_WELLFOUNDED, 3851 prim_recTheory.wellfounded_def] THEN 3852 REPEAT STRIP_TAC THEN 3853 Q.SPECL_THEN [`f`, 3854 `{x | x IN s /\ ((?y. R x y /\ y IN s) \/ 3855 (?x'. R x' x /\ x' IN s))}`, 3856 `REL_RESTRICT R s`] MP_TAC (GEN_ALL lem) THEN 3857 ASM_SIMP_TAC (srw_ss() ++ DNF_ss) [REL_RESTRICT_DEF] THEN 3858 FULL_SIMP_TAC (srw_ss()) [relationTheory.irreflexive_def] THEN 3859 CONJ_TAC THENL [ 3860 MATCH_MP_TAC SUBSET_FINITE_I THEN Q.EXISTS_TAC `s` THEN 3861 SRW_TAC [][SUBSET_DEF], 3862 METIS_TAC [] 3863 ]); 3864 3865val FINITE_StrongOrder_WF = store_thm( 3866 "FINITE_StrongOrder_WF", 3867 ``!R s. FINITE s /\ StrongOrder (REL_RESTRICT R s) ==> 3868 WF (REL_RESTRICT R s)``, 3869 SRW_TAC [][FINITE_WF_noloops, relationTheory.StrongOrder, 3870 relationTheory.transitive_TC_identity]); 3871 3872(* ===================================================================== *) 3873(* Big union (union of set of sets) *) 3874(* ===================================================================== *) 3875 3876val BIGUNION = Q.new_definition 3877 ("BIGUNION", 3878 `BIGUNION P = { x | ?s. s IN P /\ x IN s}`); 3879val _ = ot0 "BIGUNION" "bigUnion" 3880 3881(* N-ARY UNION (it's not any bigger but a different symbol) 3882val _ = Unicode.unicode_version {u = UTF8.chr 0x22C3, tmnm = "BIGUNION"}; 3883val _ = TeX_notation {hol = UTF8.chr 0x22C3, TeX = ("\\HOLTokenBigUnion{}", 1)}; 3884 *) 3885val _ = TeX_notation {hol = "BIGUNION", TeX = ("\\HOLTokenBigUnion{}", 1)}; 3886 3887Theorem IN_BIGUNION[simp]: 3888 !x sos. x IN BIGUNION sos <=> ?s. x IN s /\ s IN sos 3889Proof 3890 SIMP_TAC bool_ss [GSPECIFICATION, BIGUNION, pairTheory.PAIR_EQ] THEN 3891 MESON_TAC [] 3892QED 3893 3894val IN_BIGUNION_IMAGE = store_thm (* from util_prob *) 3895 ("IN_BIGUNION_IMAGE", 3896 ``!f s y. (y IN BIGUNION (IMAGE f s)) = (?x. x IN s /\ y IN f x)``, 3897 RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE] 3898 >> PROVE_TAC []); 3899 3900val BIGUNION_EMPTY = Q.store_thm 3901("BIGUNION_EMPTY", 3902 `BIGUNION EMPTY = EMPTY`, 3903 SIMP_TAC bool_ss [EXTENSION, IN_BIGUNION, NOT_IN_EMPTY]); 3904val _ = export_rewrites ["BIGUNION_EMPTY"] 3905 3906Theorem BIGUNION_EQ_EMPTY[simp]: 3907 !P. (BIGUNION P = {} <=> P = {} \/ P = {{}}) /\ 3908 ({} = BIGUNION P <=> P = {} \/ P = {{}}) 3909Proof 3910 SRW_TAC [][EXTENSION, IN_BIGUNION, EQ_IMP_THM, FORALL_AND_THM] THEN 3911 METIS_TAC [EXTENSION] 3912QED 3913 3914val BIGUNION_SING = Q.store_thm 3915("BIGUNION_SING", 3916 `!x. BIGUNION {x} = x`, 3917 SIMP_TAC bool_ss [EXTENSION, IN_BIGUNION, IN_INSERT, NOT_IN_EMPTY] THEN 3918 SIMP_TAC bool_ss [GSYM EXTENSION]); 3919 3920val BIGUNION_PAIR = store_thm (* from util_prob *) 3921 ("BIGUNION_PAIR", 3922 ``!s t. BIGUNION {s; t} = s UNION t``, 3923 RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_UNION, IN_INSERT, NOT_IN_EMPTY] 3924 >> PROVE_TAC []); 3925 3926val BIGUNION_UNION = Q.store_thm 3927("BIGUNION_UNION", 3928 `!s1 s2. BIGUNION (s1 UNION s2) = (BIGUNION s1) UNION (BIGUNION s2)`, 3929 SIMP_TAC bool_ss [EXTENSION, IN_UNION, IN_BIGUNION, LEFT_AND_OVER_OR, 3930 EXISTS_OR_THM]); 3931 3932val DISJOINT_BIGUNION_lemma = Q.prove 3933(`!s t. DISJOINT (BIGUNION s) t = !s'. s' IN s ==> DISJOINT s' t`, 3934 REPEAT GEN_TAC THEN EQ_TAC THEN 3935 SIMP_TAC bool_ss [DISJOINT_DEF, EXTENSION, IN_BIGUNION, IN_INTER, 3936 NOT_IN_EMPTY] THEN MESON_TAC []); 3937 3938(* above with DISJOINT x y both ways round *) 3939val DISJOINT_BIGUNION = save_thm( 3940 "DISJOINT_BIGUNION", 3941 CONJ DISJOINT_BIGUNION_lemma 3942 (ONCE_REWRITE_RULE [DISJOINT_SYM] DISJOINT_BIGUNION_lemma)); 3943 3944val BIGUNION_INSERT = Q.store_thm 3945("BIGUNION_INSERT", 3946 `!s P. BIGUNION (s INSERT P) = s UNION (BIGUNION P)`, 3947 SIMP_TAC bool_ss [EXTENSION, IN_BIGUNION, IN_UNION, IN_INSERT] THEN 3948 MESON_TAC []); 3949val _ = export_rewrites ["BIGUNION_INSERT"] 3950 3951Theorem BIGUNION_SUBSET: 3952 !X P. BIGUNION P SUBSET X <=> (!Y. Y IN P ==> Y SUBSET X) 3953Proof 3954 REPEAT STRIP_TAC THEN EQ_TAC THEN 3955 FULL_SIMP_TAC bool_ss [IN_BIGUNION, SUBSET_DEF] THEN 3956 PROVE_TAC [] 3957QED 3958 3959val BIGUNION_IMAGE_UNIV = store_thm (* from util_prob *) 3960 ("BIGUNION_IMAGE_UNIV", 3961 ``!f N. 3962 (!n. N <= n ==> (f n = {})) ==> 3963 (BIGUNION (IMAGE f UNIV) = BIGUNION (IMAGE f (count N)))``, 3964 RW_TAC std_ss [EXTENSION, IN_BIGUNION, IN_IMAGE, IN_UNIV, IN_COUNT, 3965 NOT_IN_EMPTY] 3966 >> REVERSE EQ_TAC >- PROVE_TAC [] 3967 >> RW_TAC std_ss [] 3968 >> PROVE_TAC [NOT_LESS]); 3969 3970Theorem FINITE_BIGUNION: 3971 !P. FINITE P /\ (!s. s IN P ==> FINITE s) ==> FINITE (BIGUNION P) 3972Proof 3973 Induct_on ���FINITE��� THEN 3974 SIMP_TAC bool_ss [NOT_IN_EMPTY, FINITE_EMPTY, BIGUNION_EMPTY, 3975 IN_INSERT, DISJ_IMP_THM, FORALL_AND_THM, 3976 BIGUNION_INSERT, FINITE_UNION] 3977QED 3978 3979Theorem FINITE_BIGUNION_EQ[simp]: 3980 !P. FINITE (BIGUNION P) <=> FINITE P /\ (!s. s IN P ==> FINITE s) 3981Proof 3982 SIMP_TAC (srw_ss()) [EQ_IMP_THM, FORALL_AND_THM, FINITE_BIGUNION] THEN 3983 Induct_on ���FINITE��� >> 3984 SIMP_TAC (srw_ss()) [DISJ_IMP_THM] THEN 3985 REPEAT (GEN_TAC ORELSE DISCH_THEN STRIP_ASSUME_TAC) THEN 3986 Q.RENAME_TAC [���BIGUNION Q = e INSERT P���] THEN 3987 `BIGUNION (IMAGE (\s. s DELETE e) Q) = P` 3988 by (REWRITE_TAC [EXTENSION] THEN 3989 ASM_SIMP_TAC (srw_ss() ++ DNF_ss) 3990 [IN_BIGUNION, IN_IMAGE, IN_DELETE] THEN 3991 Q.X_GEN_TAC `x` THEN EQ_TAC THEN STRIP_TAC THENL [ 3992 `x IN BIGUNION Q` by (SRW_TAC [][] THEN METIS_TAC []) THEN 3993 POP_ASSUM MP_TAC THEN METIS_TAC[IN_INSERT], 3994 `x IN (e INSERT P)` by SRW_TAC [][] THEN 3995 `~(x = e)` by PROVE_TAC [] THEN 3996 `x IN BIGUNION Q` by METIS_TAC[] THEN 3997 POP_ASSUM MP_TAC THEN SRW_TAC [][] 3998 ]) THEN 3999 `FINITE (IMAGE (\s. s DELETE e) Q) /\ 4000 !s. s IN IMAGE (\s. s DELETE e) Q ==> FINITE s` by PROVE_TAC [] THEN 4001 CONJ_TAC THENL [ 4002 Q_TAC SUFF_TAC `!x. FINITE { y | x = (\s. s DELETE e) y }` THEN1 4003 METIS_TAC [FINITELY_INJECTIVE_IMAGE_FINITE] THEN 4004 GEN_TAC THEN SIMP_TAC (srw_ss()) [] THEN 4005 Cases_on `e IN x` THENL [ 4006 Q_TAC SUFF_TAC `{y | x = y DELETE e} = {}` THEN1 SRW_TAC [][] THEN 4007 SRW_TAC [][EXTENSION, IN_DELETE, GSPECIFICATION] THEN 4008 PROVE_TAC [], 4009 Q_TAC SUFF_TAC `{y | x = y DELETE e} = {x; e INSERT x}` THEN1 4010 SRW_TAC [][] THEN 4011 SRW_TAC [][EXTENSION, IN_DELETE, GSPECIFICATION] THEN METIS_TAC [] 4012 ], 4013 REPEAT STRIP_TAC THEN 4014 `(s DELETE e) IN IMAGE (\s. s DELETE e) Q` 4015 by (SRW_TAC [][IN_IMAGE] THEN PROVE_TAC []) THEN 4016 `FINITE (s DELETE e)` by PROVE_TAC [] THEN 4017 PROVE_TAC [FINITE_DELETE] 4018 ] 4019QED 4020 4021val SUBSET_BIGUNION_I = store_thm( 4022 "SUBSET_BIGUNION_I", 4023 ``!x P. x IN P ==> x SUBSET BIGUNION P``, 4024 SRW_TAC [][BIGUNION, SUBSET_DEF] THEN METIS_TAC []); 4025 4026val CARD_BIGUNION_SAME_SIZED_SETS = store_thm( 4027 "CARD_BIGUNION_SAME_SIZED_SETS", 4028 ``!n s. 4029 FINITE s /\ (!e. e IN s ==> FINITE e /\ (CARD e = n)) /\ 4030 (!e1 e2. e1 IN s /\ e2 IN s /\ e1 <> e2 ==> DISJOINT e1 e2) ==> 4031 (CARD (BIGUNION s) = CARD s * n)``, 4032 GEN_TAC THEN 4033 SIMP_TAC bool_ss [RIGHT_FORALL_IMP_THM, GSYM AND_IMP_INTRO] THEN 4034 Induct_on `FINITE` THEN SRW_TAC [][] THEN 4035 SRW_TAC [][CARD_UNION_EQN] THEN 4036 `e INTER BIGUNION s = {}` 4037 suffices_by SRW_TAC [ARITH_ss][MULT_CLAUSES] THEN 4038 ASM_SIMP_TAC (srw_ss()) [EXTENSION] THEN 4039 Q.X_GEN_TAC `x` THEN Cases_on `x IN e` THEN 4040 ASM_SIMP_TAC (srw_ss()) [] THEN 4041 Q.X_GEN_TAC `e1` THEN Cases_on `e1 IN s` THEN SRW_TAC [][] THEN 4042 STRIP_TAC THEN 4043 `~DISJOINT e e1` 4044 by (SRW_TAC [][DISJOINT_DEF, EXTENSION] THEN METIS_TAC[]) THEN 4045 METIS_TAC[]); 4046 4047val DISJOINT_COUNT = store_thm (* from util_prob *) 4048 ("DISJOINT_COUNT", 4049 ``!f. 4050 (!m n : num. ~(m = n) ==> DISJOINT (f m) (f n)) ==> 4051 (!n. DISJOINT (f n) (BIGUNION (IMAGE f (count n))))``, 4052 RW_TAC arith_ss [DISJOINT_DEF, EXTENSION, IN_INTER, NOT_IN_EMPTY, 4053 IN_BIGUNION, IN_IMAGE, IN_COUNT] 4054 >> REVERSE (Cases_on `x IN f n`) >- PROVE_TAC [] 4055 >> RW_TAC std_ss [] 4056 >> REVERSE (Cases_on `x IN s`) >- PROVE_TAC [] 4057 >> RW_TAC std_ss [] 4058 >> REVERSE (Cases_on `x' < n`) >- PROVE_TAC [] 4059 >> RW_TAC std_ss [] 4060 >> Know `~(x':num = n)` >- DECIDE_TAC 4061 >> PROVE_TAC []); 4062 4063Theorem FORALL_IN_BIGUNION : (* from iterateTheory *) 4064 !P s. (!x. x IN BIGUNION s ==> P x) <=> !t x. t IN s /\ x IN t ==> P x 4065Proof 4066 REWRITE_TAC [IN_BIGUNION] >> PROVE_TAC [] 4067QED 4068 4069Theorem INTER_BIGUNION : (* from probabilityTheory *) 4070 (!s t. BIGUNION s INTER t = BIGUNION {x INTER t | x IN s}) /\ 4071 (!s t. t INTER BIGUNION s = BIGUNION {t INTER x | x IN s}) 4072Proof 4073 ONCE_REWRITE_TAC [EXTENSION] 4074 >> SIMP_TAC std_ss [IN_BIGUNION, GSPECIFICATION, IN_INTER] 4075 >> MESON_TAC [IN_INTER] 4076QED 4077 4078Theorem SUBSET_BIGUNION : (* from real_topologyTheory *) 4079 !f g. f SUBSET g ==> BIGUNION f SUBSET BIGUNION g 4080Proof 4081 RW_TAC std_ss [SUBSET_DEF, IN_BIGUNION] 4082 >> Q.EXISTS_TAC `s` >> ASM_REWRITE_TAC [] 4083 >> FIRST_X_ASSUM MATCH_MP_TAC 4084 >> ASM_REWRITE_TAC [] 4085QED 4086 4087(* ---------------------------------------------------------------------- 4088 BIGINTER (intersection of a set of sets) 4089 ---------------------------------------------------------------------- *) 4090 4091val BIGINTER = Q.new_definition 4092("BIGINTER", 4093 `BIGINTER P = { x | !s. s IN P ==> x IN s}`); 4094val _ = ot0 "BIGINTER" "bigIntersect" 4095 4096(* N-ARY INTERSECTION (it's not any bigger but a different symbol) 4097val _ = Unicode.unicode_version {u = UTF8.chr 0x22C2, tmnm = "BIGINTER"}; 4098val _ = TeX_notation {hol = UTF8.chr 0x22C2, TeX = ("\\HOLTokenBigInter{}", 1)}; 4099 *) 4100val _ = TeX_notation {hol = "BIGINTER", TeX = ("\\HOLTokenBigInter{}", 1)}; 4101 4102Theorem IN_BIGINTER[simp]: 4103 x IN BIGINTER B <=> !P. P IN B ==> x IN P 4104Proof 4105 SIMP_TAC bool_ss [BIGINTER, GSPECIFICATION, pairTheory.PAIR_EQ] 4106QED 4107 4108val IN_BIGINTER_IMAGE = store_thm (* from util_prob *) 4109 ("IN_BIGINTER_IMAGE", 4110 ``!x f s. (x IN BIGINTER (IMAGE f s)) = (!y. y IN s ==> x IN f y)``, 4111 RW_TAC std_ss [IN_BIGINTER, IN_IMAGE] 4112 >> PROVE_TAC []); 4113 4114val BIGINTER_INSERT = Q.store_thm 4115("BIGINTER_INSERT[simp]", 4116 `!P B. BIGINTER (P INSERT B) = P INTER BIGINTER B`, 4117 REPEAT GEN_TAC THEN CONV_TAC (REWR_CONV EXTENSION) THEN 4118 SIMP_TAC bool_ss [IN_BIGINTER, IN_INSERT, IN_INTER, DISJ_IMP_THM, 4119 FORALL_AND_THM]); 4120 4121val BIGINTER_EMPTY = Q.store_thm 4122("BIGINTER_EMPTY[simp]", 4123 `BIGINTER {} = UNIV`, 4124 REWRITE_TAC [EXTENSION, IN_BIGINTER, NOT_IN_EMPTY, IN_UNIV]); 4125 4126val BIGINTER_INTER = Q.store_thm 4127("BIGINTER_INTER[simp]", 4128 `!P Q. BIGINTER {P; Q} = P INTER Q`, 4129 REWRITE_TAC [BIGINTER_EMPTY, BIGINTER_INSERT, INTER_UNIV]); 4130 4131val BIGINTER_SING = Q.store_thm 4132("BIGINTER_SING", 4133 `!P. BIGINTER {P} = P`, 4134 SIMP_TAC bool_ss [EXTENSION, IN_BIGINTER, IN_SING] THEN 4135 SIMP_TAC bool_ss [GSYM EXTENSION]); 4136 4137Theorem SUBSET_BIGINTER: 4138 !X P. X SUBSET BIGINTER P <=> !Y. Y IN P ==> X SUBSET Y 4139Proof 4140 REPEAT STRIP_TAC THEN FULL_SIMP_TAC bool_ss [IN_BIGINTER, SUBSET_DEF] THEN 4141 PROVE_TAC [] 4142QED 4143 4144val DISJOINT_BIGINTER = Q.store_thm 4145("DISJOINT_BIGINTER", 4146 `!X Y P. Y IN P /\ DISJOINT Y X ==> 4147 DISJOINT X (BIGINTER P) /\ DISJOINT (BIGINTER P) X`, 4148 SIMP_TAC bool_ss [DISJOINT_DEF, EXTENSION, NOT_IN_EMPTY, IN_INTER, 4149 IN_BIGINTER] THEN PROVE_TAC []); 4150 4151Theorem BIGINTER_UNION: 4152 !s1 s2. BIGINTER (s1 UNION s2) = BIGINTER s1 INTER BIGINTER s2 4153Proof 4154 SIMP_TAC bool_ss [IN_BIGINTER, IN_UNION, IN_INTER, EXTENSION] THEN 4155 PROVE_TAC [] 4156QED 4157 4158val BIGINTER_SUBSET = store_thm (* from util_prob *) 4159 ("BIGINTER_SUBSET", ``!sp s. (!t. t IN s ==> t SUBSET sp) /\ (~(s = {})) 4160 ==> (BIGINTER s) SUBSET sp``, 4161 RW_TAC std_ss [SUBSET_DEF,IN_BIGINTER] 4162 >> `?u. u IN s` by METIS_TAC [CHOICE_DEF] 4163 >> METIS_TAC []); 4164 4165val DIFF_BIGINTER1 = store_thm 4166 ("DIFF_BIGINTER1", 4167 ``!sp s. sp DIFF (BIGINTER s) = BIGUNION (IMAGE (\u. sp DIFF u) s)``, 4168 (* SRW_TAC [] [EXTENSION] *) 4169 RW_TAC std_ss [EXTENSION, BIGINTER, BIGUNION, DIFF_DEF, IMAGE_DEF, IN_IMAGE, 4170 GSPECIFICATION, PAIR_EQ] 4171 >> EQ_TAC >- METIS_TAC [IN_DIFF] 4172 >> RW_TAC std_ss [] 4173 >> METIS_TAC []); 4174 4175val DIFF_BIGINTER = store_thm( (* from util_prob *) 4176 "DIFF_BIGINTER", 4177 ``!sp s. (!t. t IN s ==> t SUBSET sp) /\ s <> {} ==> 4178 (BIGINTER s = sp DIFF (BIGUNION (IMAGE (\u. sp DIFF u) s)))``, 4179 RW_TAC std_ss [] 4180 >> `(BIGINTER s SUBSET sp)` by RW_TAC std_ss [BIGINTER_SUBSET] 4181 >> ASSUME_TAC (Q.SPECL [`sp`,`s`] DIFF_BIGINTER1) 4182 >> `sp DIFF (sp DIFF (BIGINTER s)) = (BIGINTER s)` 4183 by RW_TAC std_ss [DIFF_DIFF_SUBSET] 4184 >> METIS_TAC []); 4185 4186val FINITE_BIGINTER = Q.store_thm( 4187 "FINITE_BIGINTER", 4188 ���(?s. s IN P /\ FINITE s) ==> FINITE (BIGINTER P)���, 4189 simp[PULL_EXISTS, Once DECOMPOSITION, INTER_FINITE]); 4190 4191(* ====================================================================== *) 4192(* Cross product of sets *) 4193(* ====================================================================== *) 4194 4195 4196val CROSS_DEF = Q.new_definition( 4197 "CROSS_DEF", 4198 `CROSS P Q = { p | FST p IN P /\ SND p IN Q }`); 4199val _ = set_fixity "CROSS" (Infixl 600); 4200val _ = Unicode.unicode_version {tmnm = "CROSS", u = UTF8.chr 0xD7} 4201val _ = TeX_notation {hol = "CROSS", TeX = ("\\ensuremath{\\times}", 1)} 4202val _ = TeX_notation {hol = UTF8.chr 0xD7, TeX = ("\\ensuremath{\\times}", 1)} 4203 4204Theorem IN_CROSS[simp]: 4205 !P Q x. x IN (P CROSS Q) <=> FST x IN P /\ SND x IN Q 4206Proof 4207 SIMP_TAC bool_ss [GSPECIFICATION, CROSS_DEF, PAIR_EQ] 4208QED 4209 4210val CROSS_EMPTY = store_thm( 4211 "CROSS_EMPTY", 4212 ``!P. (P CROSS {} = {}) /\ ({} CROSS P = {})``, 4213 SIMP_TAC bool_ss [EXTENSION, IN_CROSS, NOT_IN_EMPTY]); 4214val _ = export_rewrites ["CROSS_EMPTY"] 4215 4216val CROSS_EMPTY_EQN = store_thm("CROSS_EMPTY_EQN", 4217 ``(s CROSS t = {}) <=> (s = {}) \/ (t = {})``, 4218 SRW_TAC[][EQ_IMP_THM] THEN SRW_TAC[][CROSS_EMPTY] THEN 4219 FULL_SIMP_TAC(srw_ss())[EXTENSION,pairTheory.FORALL_PROD] THEN 4220 METIS_TAC[]) 4221 4222val CROSS_INSERT_LEFT = store_thm( 4223 "CROSS_INSERT_LEFT", 4224 ``!P Q x. (x INSERT P) CROSS Q = ({x} CROSS Q) UNION (P CROSS Q)``, 4225 SIMP_TAC bool_ss [EXTENSION, IN_CROSS, IN_UNION, IN_INSERT, 4226 NOT_IN_EMPTY] THEN 4227 MESON_TAC []); 4228 4229val CROSS_INSERT_RIGHT = store_thm( 4230 "CROSS_INSERT_RIGHT", 4231 ``!P Q x. P CROSS (x INSERT Q) = (P CROSS {x}) UNION (P CROSS Q)``, 4232 SIMP_TAC bool_ss [EXTENSION, IN_CROSS, IN_UNION, IN_INSERT, 4233 NOT_IN_EMPTY] THEN 4234 MESON_TAC []); 4235 4236val FINITE_CROSS = store_thm( 4237 "FINITE_CROSS", 4238 ``!P Q. FINITE P /\ FINITE Q ==> FINITE (P CROSS Q)``, 4239 SIMP_TAC bool_ss [GSYM AND_IMP_INTRO, RIGHT_FORALL_IMP_THM] THEN 4240 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4241 SIMP_TAC bool_ss [CROSS_EMPTY, FINITE_EMPTY] THEN 4242 REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC [CROSS_INSERT_LEFT] THEN 4243 ASM_SIMP_TAC bool_ss [FINITE_UNION] THEN 4244 REWRITE_TAC [FINITE_WEAK_ENUMERATE] THEN 4245 `?f b. !x. x IN Q <=> ?n. n < b /\ (x = f n)` 4246 by ASM_MESON_TAC [FINITE_WEAK_ENUMERATE] THEN 4247 Q.EXISTS_TAC `\m. (e, f m)` THEN Q.EXISTS_TAC `b` THEN 4248 ASM_SIMP_TAC bool_ss [IN_CROSS, IN_INSERT, NOT_IN_EMPTY] THEN 4249 GEN_TAC THEN Cases_on `e'` THEN 4250 SIMP_TAC bool_ss [PAIR_EQ, FST, SND] THEN MESON_TAC []); 4251 4252val CROSS_SINGS = store_thm( 4253 "CROSS_SINGS", 4254 ``!x y. {x} CROSS {y} = {(x,y)}``, 4255 SIMP_TAC bool_ss [EXTENSION, IN_INSERT, IN_CROSS, NOT_IN_EMPTY] THEN 4256 MESON_TAC [PAIR, FST, SND]); 4257val _ = export_rewrites ["CROSS_SINGS"] 4258 4259val CARD_SING_CROSS = store_thm( 4260 "CARD_SING_CROSS", 4261 ``!x P. FINITE P ==> (CARD ({x} CROSS P) = CARD P)``, 4262 GEN_TAC THEN HO_MATCH_MP_TAC FINITE_INDUCT THEN 4263 SIMP_TAC bool_ss [CROSS_EMPTY, CARD_EMPTY] THEN REPEAT STRIP_TAC THEN 4264 ONCE_REWRITE_TAC [CROSS_INSERT_RIGHT] THEN 4265 ASM_SIMP_TAC bool_ss [CROSS_SINGS, GSYM INSERT_SING_UNION] THEN 4266 `FINITE ({x} CROSS P)` by ASM_MESON_TAC [FINITE_SING, FINITE_CROSS] THEN 4267 `~((x,e) IN ({x} CROSS P))` 4268 by ASM_MESON_TAC [IN_CROSS, FST, SND, IN_SING] THEN 4269 ASM_SIMP_TAC bool_ss [CARD_INSERT]); 4270 4271val CARD_CROSS = store_thm( 4272 "CARD_CROSS", 4273 ``!P Q. FINITE P /\ FINITE Q ==> (CARD (P CROSS Q) = CARD P * CARD Q)``, 4274 SIMP_TAC bool_ss [GSYM AND_IMP_INTRO, RIGHT_FORALL_IMP_THM] THEN 4275 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4276 SIMP_TAC bool_ss [CROSS_EMPTY, CARD_EMPTY, CARD_INSERT, 4277 MULT_CLAUSES] THEN 4278 ONCE_REWRITE_TAC [CROSS_INSERT_LEFT] THEN 4279 REPEAT STRIP_TAC THEN 4280 `FINITE (P CROSS Q)` by ASM_MESON_TAC [FINITE_CROSS] THEN 4281 `FINITE ({e} CROSS Q)` by ASM_MESON_TAC [FINITE_CROSS, FINITE_SING] THEN 4282 Q.SUBGOAL_THEN `({e} CROSS Q) INTER (P CROSS Q) = {}` ASSUME_TAC THENL [ 4283 SIMP_TAC bool_ss [IN_INTER, EXTENSION, IN_CROSS, IN_SING, 4284 NOT_IN_EMPTY] THEN 4285 ASM_MESON_TAC [], 4286 ALL_TAC 4287 ] THEN 4288 CONV_TAC (LHS_CONV (REWR_CONV (GSYM ADD_0))) THEN 4289 POP_ASSUM (SUBST1_TAC o GSYM o REWRITE_RULE [CARD_EMPTY] o 4290 Q.AP_TERM `CARD`) THEN 4291 ASM_SIMP_TAC bool_ss [CARD_UNION, CARD_SING_CROSS, ADD_COMM]); 4292 4293Theorem CROSS_SUBSET: 4294 !P Q P0 Q0. (P0 CROSS Q0) SUBSET (P CROSS Q) <=> 4295 (P0 = {}) \/ (Q0 = {}) \/ P0 SUBSET P /\ Q0 SUBSET Q 4296Proof 4297 SIMP_TAC bool_ss [IN_CROSS, SUBSET_DEF, FORALL_PROD, FST, SND, 4298 NOT_IN_EMPTY, EXTENSION] THEN 4299 MESON_TAC [] 4300QED 4301 4302 4303val FINITE_CROSS_EQ_lemma0 = prove( 4304 Term`!x. FINITE x ==> 4305 !P Q. (x = P CROSS Q) ==> 4306 (P = {}) \/ (Q = {}) \/ FINITE P /\ FINITE Q`, 4307 HO_MATCH_MP_TAC FINITE_COMPLETE_INDUCTION THEN 4308 REPEAT STRIP_TAC THEN POP_ASSUM SUBST_ALL_TAC THEN 4309 `(P = {}) \/ ?p P0. (P = p INSERT P0) /\ ~(p IN P0)` by 4310 MESON_TAC [SET_CASES] THEN 4311 `(Q = {}) \/ ?q Q0. (Q = q INSERT Q0) /\ ~(q IN Q0)` by 4312 MESON_TAC [SET_CASES] THEN 4313 ASM_SIMP_TAC bool_ss [NOT_INSERT_EMPTY, FINITE_INSERT] THEN 4314 REPEAT (FIRST_X_ASSUM SUBST_ALL_TAC) THEN 4315 Q.PAT_X_ASSUM `FINITE X` MP_TAC THEN 4316 ONCE_REWRITE_TAC [CROSS_INSERT_LEFT] THEN 4317 ONCE_REWRITE_TAC [CROSS_INSERT_RIGHT] THEN 4318 SIMP_TAC bool_ss [FINITE_UNION, FINITE_SING, CROSS_SINGS] THEN 4319 REPEAT STRIP_TAC THENL [ 4320 Q.SUBGOAL_THEN 4321 `(P0 CROSS {q}) PSUBSET ((p INSERT P0) CROSS (q INSERT Q0)) \/ 4322 (P0 = {})` 4323 STRIP_ASSUME_TAC THENL [ 4324 ASM_SIMP_TAC bool_ss [PSUBSET_DEF, CROSS_SUBSET, SUBSET_INSERT, 4325 SUBSET_REFL, EXTENSION, IN_CROSS, IN_INSERT, 4326 FORALL_PROD, FST, SND, NOT_IN_EMPTY, 4327 SUBSET_DEF, IN_SING] THEN 4328 ASM_MESON_TAC [], 4329 POP_ASSUM (ANTE_RES_THEN (MP_TAC o Q.SPECL [`P0`, `{q}`])) THEN 4330 MESON_TAC [FINITE_EMPTY, NOT_INSERT_EMPTY], 4331 ASM_SIMP_TAC bool_ss [FINITE_EMPTY] 4332 ], 4333 Q.SUBGOAL_THEN 4334 `({p} CROSS Q0) PSUBSET ((p INSERT P0) CROSS (q INSERT Q0)) \/ 4335 (Q0 = {})` 4336 STRIP_ASSUME_TAC THENL [ 4337 ASM_SIMP_TAC bool_ss [PSUBSET_DEF, CROSS_SUBSET, SUBSET_INSERT, 4338 SUBSET_REFL, EXTENSION, IN_CROSS, IN_INSERT, 4339 FORALL_PROD, FST, SND, NOT_IN_EMPTY, 4340 SUBSET_DEF, IN_SING] THEN 4341 ASM_MESON_TAC [], 4342 POP_ASSUM (ANTE_RES_THEN (MP_TAC o Q.SPECL [`{p}`, `Q0`])) THEN 4343 MESON_TAC [FINITE_EMPTY, NOT_INSERT_EMPTY], 4344 ASM_SIMP_TAC bool_ss [FINITE_EMPTY] 4345 ] 4346 ]); 4347 4348val FINITE_CROSS_EQ_lemma = 4349 SIMP_RULE bool_ss [GSYM RIGHT_FORALL_IMP_THM] FINITE_CROSS_EQ_lemma0 4350 4351Theorem FINITE_CROSS_EQ[simp]: 4352 !P Q. FINITE (P CROSS Q) 4353 <=> 4354 (P = {}) \/ (Q = {}) \/ FINITE P /\ FINITE Q 4355Proof 4356 REPEAT GEN_TAC THEN EQ_TAC THEN 4357 MESON_TAC [FINITE_CROSS_EQ_lemma, FINITE_CROSS, FINITE_EMPTY, 4358 CROSS_EMPTY] 4359QED 4360 4361val CROSS_UNIV = store_thm( 4362 "CROSS_UNIV", 4363 ``univ(:'a # 'b) = univ(:'a) CROSS univ(:'b)``, 4364 SRW_TAC [][EXTENSION]); 4365 4366Theorem INFINITE_PAIR_UNIV[simp]: 4367 FINITE univ(:'a # 'b) <=> FINITE univ(:'a) /\ FINITE univ(:'b) 4368Proof 4369 FULL_SIMP_TAC (srw_ss()) [CROSS_UNIV] 4370QED 4371 4372Theorem INTER_CROSS : 4373 !A B C D. (A CROSS B) INTER (C CROSS D) = (A INTER C) CROSS (B INTER D) 4374Proof 4375 RW_TAC std_ss [Once EXTENSION, IN_INTER, IN_CROSS] 4376 >> PROVE_TAC [] 4377QED 4378 4379Theorem BIGUNION_CROSS : 4380 !f s t. (BIGUNION (IMAGE f s)) CROSS t = BIGUNION (IMAGE (\n. f n CROSS t) s) 4381Proof 4382 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_CROSS] 4383 >> EQ_TAC >> RW_TAC std_ss [] 4384 >- (Q.EXISTS_TAC ���n��� >> ASM_REWRITE_TAC []) 4385 >> ASM_REWRITE_TAC [] 4386QED 4387 4388Theorem CROSS_BIGUNION : 4389 !f s t. s CROSS (BIGUNION (IMAGE f t)) = BIGUNION (IMAGE (\n. s CROSS f n) t) 4390Proof 4391 RW_TAC std_ss [EXTENSION, IN_BIGUNION_IMAGE, IN_CROSS] 4392 >> EQ_TAC >> RW_TAC std_ss [] 4393 >- ASM_REWRITE_TAC [] 4394 >> Q.EXISTS_TAC ���n��� >> ASM_REWRITE_TAC [] 4395QED 4396 4397Theorem SUBSET_CROSS : 4398 !a b c d. a SUBSET b /\ c SUBSET d ==> (a CROSS c) SUBSET (b CROSS d) 4399Proof 4400 RW_TAC std_ss [SUBSET_DEF, IN_CROSS] 4401QED 4402 4403(* sums *) 4404 4405val SUM_UNIV = store_thm( 4406 "SUM_UNIV", 4407 ``univ(:'a + 'b) = IMAGE INL univ(:'a) UNION IMAGE INR univ(:'b)``, 4408 SRW_TAC[][EQ_IMP_THM, EXTENSION] THEN METIS_TAC [sumTheory.sum_CASES]); 4409 4410val INJ_INL = store_thm( 4411 "INJ_INL", 4412 ``(!x. x IN s ==> INL x IN t) ==> INJ INL s t``, 4413 SIMP_TAC (srw_ss()) [INJ_DEF]) 4414val INJ_INR = store_thm( 4415 "INJ_INR", 4416 ``(!x. x IN s ==> INR x IN t) ==> INJ INR s t``, 4417 SIMP_TAC (srw_ss()) [INJ_DEF]) 4418 4419val disjUNION_def = new_definition( 4420 "disjUNION_def", 4421 ���disjUNION A B = {INL a | a IN A} UNION {INR b | b IN B}���); 4422 4423val _ = set_mapped_fixity {fixity = Infixl 500, 4424 term_name = "disjUNION", 4425 tok = "<+>"} 4426val _ = set_mapped_fixity {fixity = Infixl 500, 4427 term_name = "disjUNION", 4428 tok = UTF8.chr 0x2294} 4429 4430Theorem disjUNION_UNIV: 4431 univ(:'a + 'b) = UNIV <+> UNIV 4432Proof 4433 simp[EXTENSION, disjUNION_def] >> METIS_TAC[sumTheory.sum_CASES] 4434QED 4435 4436Theorem IN_disjUNION[simp]: 4437 (INL a IN A <+> B <=> a IN A) /\ (INR b IN A <+> B <=> b IN B) 4438Proof 4439 simp[disjUNION_def] 4440QED 4441 4442Theorem CARD_disjUNION[simp]: 4443 FINITE (s:'a set) /\ FINITE (t:'b set) ==> 4444 CARD (s <+> t) = CARD s + CARD t 4445Proof 4446 simp[disjUNION_def] >> strip_tac >> 4447 Q.MATCH_ABBREV_TAC ���CARD (X UNION Y) = _��� >> 4448 ���X = IMAGE INL s /\ Y = IMAGE INR t��� by simp[Abbr���X���, Abbr���Y���, EXTENSION] >> 4449 simp[CARD_UNION_EQN, CARD_INJ_IMAGE] >> 4450 ���X INTER Y = {}��� suffices_by simp[Abbr���X���, Abbr���Y���] >> 4451 simp[EXTENSION, sumTheory.FORALL_SUM] 4452QED 4453 4454 4455(* ====================================================================== *) 4456(* Set complements. *) 4457(* ====================================================================== *) 4458 4459val COMPL_DEF = new_definition ("COMPL_DEF", ``COMPL P = UNIV DIFF P``); 4460 4461Theorem IN_COMPL[simp]: 4462 !(x:'a) s. x IN COMPL s <=> x NOTIN s 4463Proof SIMP_TAC bool_ss [COMPL_DEF, IN_DIFF, IN_UNIV] 4464QED 4465 4466val COMPL_COMPL = store_thm 4467 ("COMPL_COMPL", 4468 ``!(s:'a->bool). COMPL (COMPL s) = s``, 4469 SIMP_TAC bool_ss [EXTENSION, IN_COMPL]); 4470 4471val COMPL_CLAUSES = store_thm 4472 ("COMPL_CLAUSES", 4473 ``!(s:'a->bool). (COMPL s INTER s = {}) 4474 /\ (COMPL s UNION s = UNIV)``, 4475 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, IN_INTER, IN_UNION, NOT_IN_EMPTY, 4476 IN_UNIV]); 4477 4478val COMPL_SPLITS = store_thm 4479 ("COMPL_SPLITS", 4480 ``!(p:'a->bool) q. p INTER q UNION COMPL p INTER q = q``, 4481 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, IN_INTER, IN_UNION, NOT_IN_EMPTY, 4482 IN_UNIV] 4483 THEN MESON_TAC []); 4484 4485val INTER_UNION_COMPL = store_thm 4486 ("INTER_UNION_COMPL", 4487 ``!(s:'a->bool) t. s INTER t 4488 = COMPL (COMPL s UNION COMPL t)``, 4489 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, IN_INTER, IN_UNION, NOT_IN_EMPTY, 4490 IN_UNIV]); 4491 4492val COMPL_EMPTY = store_thm 4493 ("COMPL_EMPTY", 4494 ``COMPL {} = UNIV``, 4495 SIMP_TAC bool_ss [EXTENSION, IN_COMPL, NOT_IN_EMPTY, IN_UNIV]); 4496 4497val COMPL_INTER = store_thm( 4498 "COMPL_INTER", 4499 ``(x INTER COMPL x = {}) /\ (COMPL x INTER x = {})``, 4500 SRW_TAC [][EXTENSION]); 4501val _ = export_rewrites ["COMPL_INTER"] 4502 4503val COMPL_UNION = Q.store_thm( 4504"COMPL_UNION", 4505`COMPL (s UNION t) = COMPL s INTER COMPL t`, 4506SRW_TAC [][EXTENSION,COMPL_DEF]); 4507 4508val DIFF_INTER_COMPL = store_thm 4509 ("DIFF_INTER_COMPL", ``!s t. s DIFF t = s INTER (COMPL t)``, 4510 RW_TAC std_ss [EXTENSION, IN_DIFF, IN_INTER, IN_COMPL]); 4511 4512(*--------------------------------------------------------------------------- 4513 A "fold"-like operation for sets. 4514 ---------------------------------------------------------------------------*) 4515 4516val ITSET_def = 4517 let open TotalDefn 4518 in 4519 tDefine "ITSET" 4520 `ITSET (s:'a->bool) (b:'b) = 4521 if FINITE s then 4522 if s={} then b 4523 else ITSET (REST s) (f (CHOICE s) b) 4524 else ARB` 4525 (WF_REL_TAC `measure (CARD o FST)` THEN 4526 METIS_TAC [CARD_PSUBSET, REST_PSUBSET]) 4527 end; 4528 4529val ITSET_IND = fetch "-" "ITSET_ind"; 4530 4531(*--------------------------------------------------------------------------- 4532 Desired recursion equation. 4533 4534 |- FINITE s ==> ITSET f s b = if s = {} then b 4535 else ITSET f (REST s) (f (CHOICE s) b) 4536 ---------------------------------------------------------------------------*) 4537 4538val ITSET_THM = 4539W (GENL o rev o free_vars o concl) 4540 (DISCH_ALL(ASM_REWRITE_RULE [ASSUME ``FINITE s``] (SPEC_ALL ITSET_def))); 4541 4542val _ = save_thm("ITSET_IND",ITSET_IND); 4543val _ = save_thm("ITSET_THM",ITSET_THM); 4544val _ = save_thm("ITSET_EMPTY", 4545 REWRITE_RULE [] 4546 (MATCH_MP (SPEC ``{}`` ITSET_THM) FINITE_EMPTY)); 4547 4548(* Could also prove by 4549 4550 PROVE_TAC [FINITE_INSERT,ITSET_THM,NOT_INSERT_EMPTY]); 4551*) 4552val ITSET_INSERT = Q.store_thm 4553("ITSET_INSERT", 4554 `!s. FINITE s ==> 4555 !f x b. ITSET f (x INSERT s) b = 4556 ITSET f (REST (x INSERT s)) (f (CHOICE (x INSERT s)) b)`, 4557 REPEAT STRIP_TAC THEN 4558 POP_ASSUM (fn th => 4559 `FINITE (x INSERT s)` by PROVE_TAC [th, FINITE_INSERT]) THEN 4560 IMP_RES_TAC ITSET_THM THEN 4561 POP_ASSUM (fn th => CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV [th]))) THEN 4562 SIMP_TAC bool_ss [NOT_INSERT_EMPTY]); 4563 4564val absorption = #1 (EQ_IMP_RULE (SPEC_ALL ABSORPTION)) 4565val delete_non_element = #1 (EQ_IMP_RULE (SPEC_ALL DELETE_NON_ELEMENT)) 4566 4567val COMMUTING_ITSET_INSERT = Q.store_thm 4568("COMMUTING_ITSET_INSERT", 4569 `!f s. (!x y z. f x (f y z) = f y (f x z)) /\ 4570 FINITE s ==> 4571 !x b. ITSET f (x INSERT s) b = ITSET f (s DELETE x) (f x b)`, 4572 REPEAT GEN_TAC THEN STRIP_TAC THEN 4573 completeInduct_on `CARD s` THEN 4574 POP_ASSUM (ASSUME_TAC o SIMP_RULE bool_ss 4575 [GSYM RIGHT_FORALL_IMP_THM, AND_IMP_INTRO]) THEN 4576 GEN_TAC THEN SIMP_TAC bool_ss [ITSET_INSERT] THEN 4577 REPEAT STRIP_TAC THEN 4578 Q.ABBREV_TAC `t = REST (x INSERT s)` THEN 4579 Q.ABBREV_TAC `y = CHOICE (x INSERT s)` THEN 4580 `~(y IN t)` by PROVE_TAC [CHOICE_NOT_IN_REST] THEN 4581 Cases_on `x IN s` THENL [ 4582 FULL_SIMP_TAC bool_ss [absorption] THEN 4583 Cases_on `x = y` THENL [ 4584 POP_ASSUM SUBST_ALL_TAC THEN 4585 Q_TAC SUFF_TAC `t = s DELETE y` THEN1 SRW_TAC [][] THEN 4586 `s = y INSERT t` by PROVE_TAC [NOT_IN_EMPTY, CHOICE_INSERT_REST] THEN 4587 SRW_TAC [][DELETE_INSERT, delete_non_element], 4588 `s = y INSERT t` by PROVE_TAC [NOT_IN_EMPTY, CHOICE_INSERT_REST] THEN 4589 `x IN t` by PROVE_TAC [IN_INSERT] THEN 4590 Q.ABBREV_TAC `u = t DELETE x` THEN 4591 `t = x INSERT u` by SRW_TAC [][INSERT_DELETE, Abbr`u`] THEN 4592 `~(x IN u)` by PROVE_TAC [IN_DELETE] THEN 4593 `s = x INSERT (y INSERT u)` by simp[INSERT_COMM] THEN 4594 POP_ASSUM SUBST_ALL_TAC THEN 4595 FULL_SIMP_TAC bool_ss [FINITE_INSERT, CARD_INSERT, DELETE_INSERT, 4596 IN_INSERT] THEN 4597 ASM_SIMP_TAC arith_ss [delete_non_element] 4598 ], 4599 ALL_TAC 4600 ] THEN (* ~(x IN s) *) 4601 ASM_SIMP_TAC bool_ss [delete_non_element] THEN 4602 `x INSERT s = y INSERT t` 4603 by PROVE_TAC [NOT_EMPTY_INSERT, CHOICE_INSERT_REST] THEN 4604 Cases_on `x = y` THENL [ 4605 POP_ASSUM SUBST_ALL_TAC THEN 4606 Q_TAC SUFF_TAC `t = s` THEN1 SRW_TAC [][] THEN 4607 FULL_SIMP_TAC bool_ss [EXTENSION, IN_INSERT] THEN PROVE_TAC [], 4608 ALL_TAC 4609 ] THEN (* ~(x = y) *) 4610 `x IN t /\ y IN s` by PROVE_TAC [IN_INSERT] THEN 4611 Q.ABBREV_TAC `u = s DELETE y` THEN 4612 `~(y IN u)` by PROVE_TAC [IN_DELETE] THEN 4613 `s = y INSERT u` by SRW_TAC [][INSERT_DELETE, Abbr`u`] THEN 4614 POP_ASSUM SUBST_ALL_TAC THEN 4615 FULL_SIMP_TAC bool_ss [IN_INSERT, FINITE_INSERT, CARD_INSERT, 4616 DELETE_INSERT, delete_non_element] THEN 4617 `t = x INSERT u` by 4618 (FULL_SIMP_TAC bool_ss [EXTENSION, IN_INSERT] THEN PROVE_TAC []) THEN 4619 ASM_SIMP_TAC arith_ss [delete_non_element]); 4620 4621val COMMUTING_ITSET_RECURSES = store_thm( 4622 "COMMUTING_ITSET_RECURSES", 4623 ``!f e s b. (!x y z. f x (f y z) = f y (f x z)) /\ FINITE s ==> 4624 (ITSET f (e INSERT s) b = f e (ITSET f (s DELETE e) b))``, 4625 Q_TAC SUFF_TAC 4626 `!f. (!x y z. f x (f y z) = f y (f x z)) ==> 4627 !s. FINITE s ==> 4628 !e b. ITSET f (e INSERT s) b = f e (ITSET f (s DELETE e) b)` THEN1 4629 PROVE_TAC [] THEN 4630 GEN_TAC THEN STRIP_TAC THEN 4631 ASM_SIMP_TAC (srw_ss()) [COMMUTING_ITSET_INSERT] THEN 4632 Q_TAC SUFF_TAC 4633 `!s. FINITE s ==> !e b. ITSET f s (f e b) = f e (ITSET f s b)` THEN1 4634 PROVE_TAC [FINITE_DELETE] THEN 4635 HO_MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL [ 4636 SIMP_TAC bool_ss [ITSET_THM, FINITE_EMPTY], 4637 ASM_SIMP_TAC bool_ss [COMMUTING_ITSET_INSERT, delete_non_element] 4638 ]); 4639 4640(* ---------------------------------------------------------------------- 4641 SUM_IMAGE 4642 4643 This constant is the same as standard mathematics \Sigma operator: 4644 4645 \Sigma_{x\in P}{f(x)} = SUM_IMAGE f P 4646 4647 Where f's range is the natural numbers and P is finite. 4648 ---------------------------------------------------------------------- *) 4649 4650val SUM_IMAGE_DEF = new_definition( 4651 "SUM_IMAGE_DEF", 4652 ``SUM_IMAGE f s = ITSET (\e acc. f e + acc) s 0``); 4653 4654val _ = overload_on ("SIGMA", ``SUM_IMAGE``); 4655val _ = Unicode.unicode_version {u = UTF8.chr 0x2211, tmnm = "SIGMA"}; 4656val _ = TeX_notation {hol = UTF8.chr 0x2211, TeX = ("\\HOLTokenSum{}", 1)}; 4657val _ = TeX_notation {hol = "SIGMA", TeX = ("\\HOLTokenSum{}", 1)}; 4658 4659val SUM_IMAGE_THM = store_thm( 4660 "SUM_IMAGE_THM", 4661 ``!f. (SUM_IMAGE f {} = 0) /\ 4662 (!e s. FINITE s ==> 4663 (SUM_IMAGE f (e INSERT s) = 4664 f e + SUM_IMAGE f (s DELETE e)))``, 4665 REPEAT STRIP_TAC THENL [ 4666 SIMP_TAC (srw_ss()) [ITSET_THM, SUM_IMAGE_DEF], 4667 SIMP_TAC (srw_ss()) [SUM_IMAGE_DEF] THEN 4668 Q.ABBREV_TAC `g = \e acc. f e + acc` THEN 4669 Q_TAC SUFF_TAC `ITSET g (e INSERT s) 0 = 4670 g e (ITSET g (s DELETE e) 0)` THEN1 4671 SRW_TAC [][Abbr`g`] THEN 4672 MATCH_MP_TAC COMMUTING_ITSET_RECURSES THEN 4673 SRW_TAC [ARITH_ss][Abbr`g`] 4674 ]); 4675 4676val SUM_IMAGE_SING = store_thm( 4677 "SUM_IMAGE_SING", 4678 ``!f e. SUM_IMAGE f {e} = f e``, 4679 SRW_TAC [][SUM_IMAGE_THM]); 4680 4681val SUM_IMAGE_SUBSET_LE = store_thm( 4682 "SUM_IMAGE_SUBSET_LE", 4683 ``!f s t. FINITE s /\ t SUBSET s ==> SUM_IMAGE f t <= SUM_IMAGE f s``, 4684 GEN_TAC THEN 4685 Q_TAC SUFF_TAC `!s. FINITE s ==> 4686 !t. t SUBSET s ==> SUM_IMAGE f t <= SUM_IMAGE f s` THEN1 4687 PROVE_TAC [] THEN 4688 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4689 SIMP_TAC (srw_ss()) [SUM_IMAGE_THM, delete_non_element] THEN 4690 REPEAT STRIP_TAC THEN Cases_on `e IN t` THENL [ 4691 Q.ABBREV_TAC `u = t DELETE e` THEN 4692 `t = e INSERT u` by SRW_TAC [][INSERT_DELETE, Abbr`u`] THEN 4693 `FINITE u` by PROVE_TAC [FINITE_DELETE, SUBSET_FINITE, FINITE_INSERT] THEN 4694 `~(e IN u)` by PROVE_TAC [IN_DELETE] THEN 4695 ASM_SIMP_TAC arith_ss [SUM_IMAGE_THM, delete_non_element] THEN 4696 FIRST_X_ASSUM MATCH_MP_TAC THEN 4697 FULL_SIMP_TAC bool_ss [SUBSET_INSERT_DELETE], 4698 FULL_SIMP_TAC bool_ss [SUBSET_INSERT] THEN 4699 RES_TAC THEN ASM_SIMP_TAC arith_ss [] 4700 ]); 4701 4702val SUM_IMAGE_IN_LE = store_thm( 4703 "SUM_IMAGE_IN_LE", 4704 ``!f s e. FINITE s /\ e IN s ==> f e <= SUM_IMAGE f s``, 4705 REPEAT STRIP_TAC THEN 4706 `{e} SUBSET s` by SRW_TAC [][SUBSET_DEF] THEN 4707 PROVE_TAC [SUM_IMAGE_SING, SUM_IMAGE_SUBSET_LE]); 4708 4709val SUM_IMAGE_DELETE = store_thm( 4710 "SUM_IMAGE_DELETE", 4711 ``!f s. FINITE s ==> 4712 !e. SUM_IMAGE f (s DELETE e) = if e IN s then SUM_IMAGE f s - f e 4713 else SUM_IMAGE f s``, 4714 GEN_TAC THEN HO_MATCH_MP_TAC FINITE_INDUCT THEN 4715 SRW_TAC [][SUM_IMAGE_THM, DELETE_INSERT] THEN 4716 COND_CASES_TAC THENL [ 4717 POP_ASSUM SUBST_ALL_TAC THEN ASM_SIMP_TAC arith_ss [], 4718 ASM_SIMP_TAC bool_ss [SUM_IMAGE_THM, FINITE_DELETE, IN_DELETE, 4719 delete_non_element] THEN 4720 COND_CASES_TAC THEN REWRITE_TAC [] THEN 4721 `f e' <= SUM_IMAGE f s` by PROVE_TAC [SUM_IMAGE_IN_LE] THEN 4722 FULL_SIMP_TAC arith_ss [] 4723 ]); 4724 4725val SUM_IMAGE_UNION = store_thm( 4726 "SUM_IMAGE_UNION", 4727 ``!f s t. FINITE s /\ FINITE t ==> 4728 (SUM_IMAGE f (s UNION t) = 4729 SUM_IMAGE f s + SUM_IMAGE f t - SUM_IMAGE f (s INTER t))``, 4730 GEN_TAC THEN 4731 Q_TAC SUFF_TAC 4732 `!s. FINITE s ==> 4733 !t. FINITE t ==> 4734 (SUM_IMAGE f (s UNION t) = 4735 SUM_IMAGE f s + SUM_IMAGE f t - SUM_IMAGE f (s INTER t))` THEN1 4736 PROVE_TAC [] THEN 4737 HO_MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THEN1 4738 SRW_TAC [ARITH_ss][SUM_IMAGE_THM] THEN 4739 SIMP_TAC (srw_ss()) [INSERT_UNION_EQ, SUM_IMAGE_THM, INSERT_INTER] THEN 4740 REPEAT STRIP_TAC THEN 4741 Cases_on `e IN t` THEN 4742 ASM_SIMP_TAC arith_ss [INSERT_INTER, INTER_FINITE, FINITE_INSERT, 4743 SUM_IMAGE_THM, IN_UNION, delete_non_element] 4744 THENL [ 4745 `s UNION t DELETE e = s UNION (t DELETE e)` by 4746 (SRW_TAC [][EXTENSION, IN_UNION, IN_DELETE] THEN PROVE_TAC []) THEN 4747 ASM_SIMP_TAC bool_ss [FINITE_DELETE, SUM_IMAGE_DELETE, INTER_FINITE, 4748 IN_INTER] THEN 4749 `s INTER (t DELETE e) = s INTER t DELETE e` by 4750 (SRW_TAC [][EXTENSION, IN_DELETE] THEN PROVE_TAC []) THEN 4751 ASM_SIMP_TAC bool_ss [SUM_IMAGE_DELETE, INTER_FINITE, IN_INTER] THEN 4752 `f e <= SUM_IMAGE f t` by PROVE_TAC [SUM_IMAGE_IN_LE] THEN 4753 `s INTER t SUBSET t` by PROVE_TAC [INTER_SUBSET] THEN 4754 `SUM_IMAGE f (s INTER t) <= SUM_IMAGE f t` by 4755 PROVE_TAC [SUM_IMAGE_SUBSET_LE] THEN 4756 Q_TAC SUFF_TAC `f e + SUM_IMAGE f (s INTER t) <= SUM_IMAGE f t` THEN1 4757 ASM_SIMP_TAC arith_ss [] THEN 4758 Q_TAC SUFF_TAC 4759 `f e + SUM_IMAGE f (s INTER t) = 4760 SUM_IMAGE f (e INSERT s INTER t)` THEN1 4761 ASM_SIMP_TAC bool_ss [SUM_IMAGE_SUBSET_LE, 4762 SUBSET_DEF, IN_INTER, IN_INSERT, 4763 DISJ_IMP_THM, FORALL_AND_THM] THEN 4764 ASM_SIMP_TAC bool_ss [INTER_FINITE, SUM_IMAGE_THM, IN_INTER, 4765 delete_non_element], 4766 `s INTER t SUBSET t` by PROVE_TAC [INTER_SUBSET] THEN 4767 `SUM_IMAGE f (s INTER t) <= SUM_IMAGE f t` 4768 by PROVE_TAC [SUM_IMAGE_SUBSET_LE] THEN 4769 ASM_SIMP_TAC arith_ss [] 4770 ]); 4771 4772val SUM_IMAGE_lower_bound = store_thm( 4773 "SUM_IMAGE_lower_bound", 4774 ``!s. FINITE s ==> 4775 !n. (!x. x IN s ==> n <= f x) ==> 4776 CARD s * n <= SUM_IMAGE f s``, 4777 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4778 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM, SUM_IMAGE_THM, 4779 MULT_CLAUSES, CARD_EMPTY, CARD_INSERT] THEN 4780 `s DELETE e = s` by (SRW_TAC [][EXTENSION, IN_DELETE] THEN PROVE_TAC []) THEN 4781 SRW_TAC [][] THEN 4782 PROVE_TAC [LESS_EQ_LESS_EQ_MONO, ADD_COMM]); 4783 4784val SUM_IMAGE_upper_bound = store_thm( 4785 "SUM_IMAGE_upper_bound", 4786 ``!s. FINITE s ==> 4787 !n. (!x. x IN s ==> f x <= n) ==> 4788 SUM_IMAGE f s <= CARD s * n``, 4789 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4790 SRW_TAC [][DISJ_IMP_THM, FORALL_AND_THM, SUM_IMAGE_THM, 4791 MULT_CLAUSES, CARD_EMPTY, CARD_INSERT] THEN 4792 `s DELETE e = s` by (SRW_TAC [][EXTENSION, IN_DELETE] THEN PROVE_TAC []) THEN 4793 SRW_TAC [][] THEN 4794 PROVE_TAC [LESS_EQ_LESS_EQ_MONO, ADD_COMM]); 4795 4796val DISJ_BIGUNION_CARD = Q.prove ( 4797`!P. FINITE P 4798 ==> (!s. s IN P ==> FINITE s) /\ 4799 (!s t. s IN P /\ t IN P /\ ~(s = t) ==> DISJOINT s t) 4800 ==> (CARD (BIGUNION P) = SUM_IMAGE CARD P)`, 4801 SET_INDUCT_TAC THEN 4802 RW_TAC bool_ss [CARD_EMPTY,BIGUNION_EMPTY,SUM_IMAGE_THM, 4803 BIGUNION_INSERT] THEN 4804 `FINITE (BIGUNION s) /\ FINITE e` 4805 by METIS_TAC [FINITE_BIGUNION, IN_INSERT] THEN 4806 `!s'. s' IN s ==> DISJOINT e s'` by METIS_TAC [IN_INSERT] THEN 4807 `CARD (e INTER (BIGUNION s)) = 0` 4808 by METIS_TAC [DISJOINT_DEF,DISJOINT_BIGUNION,CARD_EMPTY] THEN 4809 `CARD (e UNION BIGUNION s) = CARD (e UNION BIGUNION s) + 4810 CARD (e INTER (BIGUNION s))` 4811 by RW_TAC arith_ss [] THEN 4812 ONCE_ASM_REWRITE_TAC [] THEN 4813 FULL_SIMP_TAC arith_ss [CARD_UNION, DELETE_NON_ELEMENT] THEN 4814 METIS_TAC [IN_INSERT]); 4815 4816val SUM_SAME_IMAGE = Q.store_thm 4817("SUM_SAME_IMAGE", 4818 `!P. FINITE P 4819 ==> !f p. p IN P /\ (!q. q IN P ==> (f p = f q)) 4820 ==> (SUM_IMAGE f P = CARD P * f p)`, 4821 SET_INDUCT_TAC THEN 4822 RW_TAC arith_ss [CARD_EMPTY, SUM_IMAGE_THM, CARD_INSERT, ADD1] THEN 4823 SRW_TAC [][delete_non_element] THEN 4824 `(s = {}) \/ (?x t. s = x INSERT t)` 4825 by METIS_TAC [TypeBase.nchotomy_of ``:'a set``] 4826 THENL [ 4827 SRW_TAC [][SUM_IMAGE_THM], 4828 `(f e = f x) /\ (f p = f x)` 4829 by (FULL_SIMP_TAC (srw_ss()) [] THEN METIS_TAC []) THEN 4830 Q_TAC SUFF_TAC `SIGMA f s = CARD s * f x` 4831 THEN1 SRW_TAC [ARITH_ss][] THEN 4832 FULL_SIMP_TAC (srw_ss() ++ DNF_ss) [] 4833 ]); 4834 4835val SUM_IMAGE_CONG = Q.store_thm( 4836"SUM_IMAGE_CONG", 4837`(s1 = s2) /\ (!x. x IN s2 ==> (f1 x = f2 x)) 4838 ==> (SIGMA f1 s1 = SIGMA f2 s2)`, 4839SRW_TAC [][] THEN 4840REVERSE (Cases_on `FINITE s1`) THEN1 ( 4841 SRW_TAC [][SUM_IMAGE_DEF,Once ITSET_def] THEN 4842 SRW_TAC [][Once ITSET_def] ) THEN 4843Q.PAT_X_ASSUM `!x.P` MP_TAC THEN 4844POP_ASSUM MP_TAC THEN 4845Q.ID_SPEC_TAC `s1` THEN 4846HO_MATCH_MP_TAC FINITE_INDUCT THEN 4847SRW_TAC [][SUM_IMAGE_THM,SUM_IMAGE_DELETE]) 4848val _ = DefnBase.export_cong "SUM_IMAGE_CONG" 4849 4850Theorem SUM_IMAGE_ZERO: 4851 !s. FINITE s ==> ((SIGMA f s = 0) <=> (!x. x IN s ==> (f x = 0))) 4852Proof 4853 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4854 CONJ_TAC THEN1 SIMP_TAC bool_ss [SUM_IMAGE_THM,NOT_IN_EMPTY] THEN 4855 SIMP_TAC bool_ss [SUM_IMAGE_THM,DELETE_NON_ELEMENT,ADD_EQ_0,IN_INSERT] THEN 4856 METIS_TAC [] 4857QED 4858 4859Theorem ABS_DIFF_SUM_IMAGE: 4860 !s. FINITE s ==> 4861 (ABS_DIFF (SIGMA f s) (SIGMA g s) <= SIGMA (\x. ABS_DIFF (f x) (g x)) s) 4862Proof 4863 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4864 SRW_TAC [][] THEN1 ( 4865 SRW_TAC [][SUM_IMAGE_THM,ABS_DIFF_EQS] ) THEN 4866 SRW_TAC [][SUM_IMAGE_THM] THEN 4867 FULL_SIMP_TAC (srw_ss()) [DELETE_NON_ELEMENT] THEN 4868 MATCH_MP_TAC LESS_EQ_TRANS THEN 4869 Q.EXISTS_TAC `ABS_DIFF (f e) (g e) + ABS_DIFF (SIGMA f s) (SIGMA g s)` THEN 4870 SRW_TAC [][ABS_DIFF_SUMS] 4871QED 4872 4873Theorem SUM_IMAGE_MONO_LESS_EQ: 4874 !s. FINITE s ==> 4875 (!x. x IN s ==> f x <= g x) ==> SUM_IMAGE f s <= SUM_IMAGE g s 4876Proof 4877 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4878 SRW_TAC [][SUM_IMAGE_THM] THEN 4879 FULL_SIMP_TAC (srw_ss()) [DELETE_NON_ELEMENT] THEN 4880 MATCH_MP_TAC LESS_EQ_LESS_EQ_MONO THEN 4881 SRW_TAC [][] 4882QED 4883 4884Theorem SUM_IMAGE_MONO_LESS: 4885 !s. FINITE s ==> (?x. x IN s /\ f x < g x) /\ (!x. x IN s ==> f x <= g x) ==> 4886 SUM_IMAGE f s < SUM_IMAGE g s 4887Proof 4888 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4889 SRW_TAC [][SUM_IMAGE_THM] THEN 4890 FULL_SIMP_TAC (srw_ss()) [DELETE_NON_ELEMENT] THEN1 ( 4891 MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN 4892 Q.EXISTS_TAC `g e + SIGMA f s` THEN 4893 SRW_TAC [][] THEN 4894 MATCH_MP_TAC (MP_CANON SUM_IMAGE_MONO_LESS_EQ) THEN 4895 SRW_TAC [][] ) THEN 4896 `SIGMA f s < SIGMA g s` by METIS_TAC [] THEN 4897 MATCH_MP_TAC LESS_LESS_EQ_TRANS THEN 4898 Q.EXISTS_TAC `f e + SIGMA g s` THEN 4899 SRW_TAC [][] 4900QED 4901 4902val SUM_IMAGE_INJ_o = store_thm( 4903 "SUM_IMAGE_INJ_o", 4904 ``!s. FINITE s ==> !g. INJ g s univ(:'a) ==> 4905 !f. SIGMA f (IMAGE g s) = SIGMA (f o g) s``, 4906 HO_MATCH_MP_TAC FINITE_INDUCT THEN 4907 REPEAT STRIP_TAC THEN1 4908 SRW_TAC[][SUM_IMAGE_THM] THEN 4909 `INJ g s univ(:'a) /\ g e IN univ(:'a) /\ 4910 !y. y IN s /\ (g e = g y) ==> (e = y)` 4911 by METIS_TAC[INJ_INSERT] THEN 4912 `g e NOTIN (IMAGE g s)` by METIS_TAC[IN_IMAGE] THEN 4913 `(s DELETE e = s) /\ (IMAGE g s DELETE g e = IMAGE g s)` 4914 by METIS_TAC[DELETE_NON_ELEMENT] THEN 4915 SRW_TAC[][SUM_IMAGE_THM, IMAGE_FINITE]); 4916 4917val _ = overload_on("PERMUTES", ``\f s. BIJ f s s``); 4918val _ = set_fixity "PERMUTES" (Infix(NONASSOC, 450)); (* same as relation *) 4919 4920val SUM_IMAGE_PERMUTES = store_thm( 4921 "SUM_IMAGE_PERMUTES", 4922 ``!s. FINITE s ==> !g. g PERMUTES s ==> !f. SIGMA (f o g) s = SIGMA f s``, 4923 REPEAT STRIP_TAC THEN 4924 `INJ g s s /\ SURJ g s s` by METIS_TAC[BIJ_DEF] THEN 4925 `IMAGE g s = s` by SRW_TAC[][GSYM IMAGE_SURJ] THEN 4926 `s SUBSET univ(:'a)` by SRW_TAC[][SUBSET_UNIV] THEN 4927 `INJ g s univ(:'a)` by METIS_TAC[INJ_SUBSET, SUBSET_REFL] THEN 4928 `SIGMA (f o g) s = SIGMA f (IMAGE g s)` by SRW_TAC[][SUM_IMAGE_INJ_o] THEN 4929 SRW_TAC[][]); 4930 4931(*---------------------------------------------------------------------------*) 4932(* SUM_SET sums the elements of a set of natural numbers *) 4933(*---------------------------------------------------------------------------*) 4934 4935val SUM_SET_DEF = new_definition("SUM_SET_DEF", ``SUM_SET = SUM_IMAGE I``); 4936 4937val SUM_SET_THM = store_thm( 4938 "SUM_SET_THM", 4939 ``(SUM_SET {} = 0) /\ 4940 (!x s. FINITE s ==> (SUM_SET (x INSERT s) = x + SUM_SET (s DELETE x)))``, 4941 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_THM]); 4942 4943Theorem SUM_SET_EMPTY[simp] = CONJUNCT1 SUM_SET_THM; 4944 4945Theorem SUM_SET_SING[simp]: 4946 !n. SUM_SET {n} = n 4947Proof 4948 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_SING] 4949QED 4950 4951val SUM_SET_SUBSET_LE = store_thm( 4952 "SUM_SET_SUBSET_LE", 4953 ``!s t. FINITE t /\ s SUBSET t ==> SUM_SET s <= SUM_SET t``, 4954 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_SUBSET_LE]); 4955 4956val SUM_SET_IN_LE = store_thm( 4957 "SUM_SET_IN_LE", 4958 ``!x s. FINITE s /\ x IN s ==> x <= SUM_SET s``, 4959 SRW_TAC [][SUM_SET_DEF] THEN 4960 PROVE_TAC [combinTheory.I_THM, SUM_IMAGE_IN_LE]); 4961 4962val SUM_SET_DELETE = store_thm( 4963 "SUM_SET_DELETE", 4964 ``!s. FINITE s ==> !e. SUM_SET (s DELETE e) = if e IN s then SUM_SET s - e 4965 else SUM_SET s``, 4966 SIMP_TAC (srw_ss()) [SUM_SET_DEF, SUM_IMAGE_DELETE]); 4967 4968val SUM_SET_UNION = store_thm( 4969 "SUM_SET_UNION", 4970 ``!s t. FINITE s /\ FINITE t ==> 4971 (SUM_SET (s UNION t) = 4972 SUM_SET s + SUM_SET t - SUM_SET (s INTER t))``, 4973 SRW_TAC [][SUM_SET_DEF, SUM_IMAGE_UNION]); 4974 4975Theorem SUM_SET_count_2: 4976 !n. 2 * SUM_SET (count n) = n * (n - 1) 4977Proof 4978 Induct >> 4979 rw [ 4980 COUNT_SUC, SUM_SET_THM, LEFT_ADD_DISTRIB, SUM_SET_DELETE, ADD1, 4981 LEFT_SUB_DISTRIB, RIGHT_ADD_DISTRIB, SUM_SQUARED 4982 ] >> 4983 `n <= n ** 2` by rw[] >> 4984 rw[] 4985QED 4986 4987Theorem SUM_SET_count: 4988 SUM_SET (count n) = n * (n - 1) DIV 2 4989Proof 4990 Q.MATCH_ABBREV_TAC `a = b` >> 4991 ���2 * a = 2 * b��� suffices_by simp[] >> 4992 markerLib.UNABBREV_ALL_TAC >> 4993 REWRITE_TAC[SUM_SET_count_2] >> 4994 Q.SPEC_THEN ���2��� mp_tac DIVISION >> simp[] >> 4995 disch_then (Q.SPEC_THEN ���n * (n - 1)��� assume_tac) >> 4996 Q.MATCH_ABBREV_TAC ���(a = 2 * (a DIV 2))��� >> 4997 ���a MOD 2 = 0��� suffices_by (strip_tac >> fs[]) >> 4998 simp[Abbr`a`,GSYM EVEN_MOD2, LEFT_SUB_DISTRIB, EVEN_SUB, EVEN_EXP_IFF] 4999QED 5000 5001(* ---------------------------------------------------------------------- 5002 PROD_IMAGE 5003 5004 This construct is the same as standard mathematics \Pi operator: 5005 5006 \Pi_{x\in P}{f(x)} = PROD_IMAGE f P 5007 5008 Where f's range is the natural numbers and P is finite. 5009 ---------------------------------------------------------------------- *) 5010 5011(* Define PROD_IMAGE similar to SUM_IMAGE *) 5012val PROD_IMAGE_DEF = new_definition( 5013 "PROD_IMAGE_DEF", 5014 ``PROD_IMAGE f s = ITSET (\e acc. f e * acc) s 1``); 5015 5016(* Theorem: property of PROD_IMAGE *) 5017val PROD_IMAGE_THM = store_thm( 5018 "PROD_IMAGE_THM", 5019 ``!f. (PROD_IMAGE f {} = 1) /\ 5020 (!e s. FINITE s ==> 5021 (PROD_IMAGE f (e INSERT s) = f e * PROD_IMAGE f (s DELETE e)))``, 5022 REPEAT STRIP_TAC THEN1 5023 SIMP_TAC (srw_ss()) [ITSET_THM, PROD_IMAGE_DEF] THEN 5024 SIMP_TAC (srw_ss()) [PROD_IMAGE_DEF] THEN 5025 Q.ABBREV_TAC `g = \e acc. f e * acc` THEN 5026 Q_TAC SUFF_TAC `ITSET g (e INSERT s) 1 = 5027 g e (ITSET g (s DELETE e) 1)` THEN1 SRW_TAC [][Abbr`g`] THEN 5028 MATCH_MP_TAC COMMUTING_ITSET_RECURSES THEN 5029 SRW_TAC [ARITH_ss][Abbr`g`]); 5030 5031val _ = overload_on ("PI", ``PROD_IMAGE``) 5032val _ = Unicode.unicode_version {tmnm = "PROD_IMAGE", u = UnicodeChars.Pi} 5033 5034(*---------------------------------------------------------------------------*) 5035(* PROD_SET multiplies the elements of a set of natural numbers *) 5036(*---------------------------------------------------------------------------*) 5037 5038(* Define PROD_SET similar to SUM_SET *) 5039val PROD_SET_DEF = new_definition("PROD_SET_DEF", ``PROD_SET = PROD_IMAGE I``); 5040 5041(* Theorem: Product Set property *) 5042val PROD_SET_THM = store_thm( 5043 "PROD_SET_THM", 5044 ``(PROD_SET {} = 1) /\ 5045 (!x s. FINITE s ==> (PROD_SET (x INSERT s) = x * PROD_SET (s DELETE x)))``, 5046 SRW_TAC [][PROD_SET_DEF, PROD_IMAGE_THM]); 5047 5048val PROD_SET_EMPTY = save_thm("PROD_SET_EMPTY", CONJUNCT1 PROD_SET_THM); 5049 5050(* Theorem: PROD_SET (IMAGE f (x INSERT s)) = (f x) * PROD_SET (IMAGE f s) *) 5051(* Proof: 5052 PROD_SET (IMAGE f (x INSERT s)) 5053 = PROD_SET (f x INSERT IMAGE f s) by IMAGE_INSERT 5054 = f x * PROD_SET (IMAGE f s) DELETE (f x) by PROD_SET_THM, assume FINITE (IMAGE f s) 5055 = f x * PROD_SET (IMAGE f s) by (f x) not in (IMAGE f s) 5056*) 5057val PROD_SET_IMAGE_REDUCTION = store_thm( 5058 "PROD_SET_IMAGE_REDUCTION", 5059 ``!f s x. FINITE (IMAGE f s) /\ f x NOTIN IMAGE f s ==> 5060 (PROD_SET (IMAGE f (x INSERT s)) = (f x) * PROD_SET (IMAGE f s))``, 5061 METIS_TAC [DELETE_NON_ELEMENT, IMAGE_INSERT, PROD_SET_THM]); 5062 5063 5064(* every finite, non-empty set of natural numbers has a maximum element *) 5065 5066val max_lemma = prove( 5067 ``!s. FINITE s ==> ?x. (s <> {} ==> x IN s /\ !y. y IN s ==> y <= x) /\ 5068 ((s = {}) ==> (x = 0))``, 5069 HO_MATCH_MP_TAC FINITE_INDUCT THEN 5070 SIMP_TAC bool_ss [NOT_INSERT_EMPTY, IN_INSERT] THEN 5071 REPEAT STRIP_TAC THEN 5072 Q.ISPEC_THEN `s` STRIP_ASSUME_TAC SET_CASES THENL [ 5073 ASM_SIMP_TAC arith_ss [NOT_IN_EMPTY], 5074 `~(s = {})` by PROVE_TAC [NOT_INSERT_EMPTY] THEN 5075 `?m. m IN s /\ !y. y IN s ==> y <= m` by PROVE_TAC [] THEN 5076 Cases_on `e <= m` THENL [ 5077 PROVE_TAC [], 5078 `m <= e` by RW_TAC arith_ss [] THEN 5079 PROVE_TAC [LESS_EQ_REFL, LESS_EQ_TRANS] 5080 ] 5081 ]) 5082 5083val MAX_SET_DEF = new_specification ( 5084 "MAX_SET_DEF", ["MAX_SET"], 5085 CONV_RULE (BINDER_CONV RIGHT_IMP_EXISTS_CONV THENC 5086 SKOLEM_CONV) max_lemma); 5087 5088val MAX_SET_THM = store_thm( 5089 "MAX_SET_THM", 5090 ``(MAX_SET {} = 0) /\ 5091 (!e s. FINITE s ==> (MAX_SET (e INSERT s) = MAX e (MAX_SET s)))``, 5092 CONJ_TAC THENL [ 5093 STRIP_ASSUME_TAC (SIMP_RULE bool_ss [FINITE_EMPTY] 5094 (Q.SPEC `{}` MAX_SET_DEF)), 5095 REPEAT STRIP_TAC THEN 5096 Q.ISPEC_THEN `e INSERT s` MP_TAC MAX_SET_DEF THEN 5097 ASM_SIMP_TAC bool_ss [FINITE_INSERT, NOT_INSERT_EMPTY, 5098 IN_INSERT, FORALL_AND_THM, DISJ_IMP_THM] THEN 5099 STRIP_TAC THEN 5100 Q.ISPEC_THEN `s` MP_TAC MAX_SET_DEF THEN 5101 ASM_REWRITE_TAC [] THEN 5102 STRIP_TAC THEN 5103 Q.ABBREV_TAC `m1 = MAX_SET (e INSERT s)` THEN 5104 Q.ABBREV_TAC `m2 = MAX_SET s` THEN 5105 NTAC 2 (POP_ASSUM (K ALL_TAC)) THEN 5106 Q.ASM_CASES_TAC `s = {}` THEN FULL_SIMP_TAC (srw_ss()) [] THEN 5107 RES_TAC THEN ASM_SIMP_TAC arith_ss [MAX_DEF] 5108 ]); 5109 5110val MAX_SET_REWRITES = store_thm( 5111 "MAX_SET_REWRITES", 5112 ``(MAX_SET {} = 0) /\ (MAX_SET {e} = e)``, 5113 SRW_TAC[][MAX_SET_THM]); 5114val _ = export_rewrites ["MAX_SET_REWRITES"] 5115 5116val MAX_SET_ELIM = store_thm( 5117 "MAX_SET_ELIM", 5118 ``!P Q. FINITE P /\ ((P = {}) ==> Q 0) /\ (!x. (!y. y IN P ==> y <= x) /\ x IN P ==> Q x) ==> 5119 Q (MAX_SET P)``, 5120 PROVE_TAC [MAX_SET_DEF]); 5121 5122val MIN_SET_DEF = new_definition("MIN_SET_DEF", ``MIN_SET = $LEAST``); 5123 5124val MIN_SET_ELIM = store_thm( 5125 "MIN_SET_ELIM", 5126 ``!P Q. ~(P = {}) /\ (!x. (!y. y IN P ==> x <= y) /\ x IN P ==> Q x) ==> 5127 Q (MIN_SET P)``, 5128 REWRITE_TAC [MIN_SET_DEF] THEN REPEAT STRIP_TAC THEN 5129 MATCH_MP_TAC LEAST_ELIM THEN CONJ_TAC THENL [ 5130 `?x. P x` by PROVE_TAC [SET_CASES, IN_INSERT, SPECIFICATION] THEN 5131 PROVE_TAC [], 5132 FULL_SIMP_TAC arith_ss [SPECIFICATION] THEN 5133 PROVE_TAC [NOT_LESS] 5134 ]); 5135 5136val MIN_SET_THM = store_thm( 5137 "MIN_SET_THM", 5138 ``(!e. MIN_SET {e} = e) /\ 5139 (!s e1 e2. MIN_SET (e1 INSERT e2 INSERT s) = 5140 MIN e1 (MIN_SET (e2 INSERT s)))``, 5141 CONJ_TAC THENL [ 5142 GEN_TAC THEN 5143 Q.SPECL_THEN [`{e}`, `\x. x = e`] (MATCH_MP_TAC o BETA_RULE) 5144 MIN_SET_ELIM THEN 5145 SIMP_TAC bool_ss [IN_INSERT, NOT_INSERT_EMPTY, DISJ_IMP_THM, 5146 NOT_IN_EMPTY], 5147 REPEAT GEN_TAC THEN 5148 Q.SPECL_THEN [`e1 INSERT e2 INSERT s`, 5149 `\x. x = MIN e1 (MIN_SET (e2 INSERT s))`] 5150 (MATCH_MP_TAC o BETA_RULE) 5151 MIN_SET_ELIM THEN 5152 SIMP_TAC bool_ss [IN_INSERT, NOT_INSERT_EMPTY, DISJ_IMP_THM, 5153 FORALL_AND_THM] THEN 5154 REPEAT STRIP_TAC THEN 5155 Q.SPECL_THEN [`e2 INSERT s`, `\y. x = MIN e1 y`] 5156 (MATCH_MP_TAC o BETA_RULE) 5157 MIN_SET_ELIM THEN 5158 SIMP_TAC bool_ss [IN_INSERT, NOT_INSERT_EMPTY, DISJ_IMP_THM, 5159 FORALL_AND_THM] THEN 5160 REPEAT STRIP_TAC THEN RES_TAC THEN ASM_SIMP_TAC arith_ss [MIN_DEF] 5161 ]); 5162 5163val MIN_SET_LEM = Q.store_thm 5164("MIN_SET_LEM", 5165 `!s. ~(s={}) ==> (MIN_SET s IN s) /\ !x. x IN s ==> MIN_SET s <= x`, 5166 METIS_TAC [GSYM MEMBER_NOT_EMPTY,MIN_SET_DEF, 5167 IN_DEF,whileTheory.FULL_LEAST_INTRO]); 5168 5169val SUBSET_MIN_SET = Q.store_thm 5170("SUBSET_MIN_SET", 5171 `!I J n. ~(I={}) /\ ~(J={}) /\ I SUBSET J ==> MIN_SET J <= MIN_SET I`, 5172 METIS_TAC [SUBSET_DEF,MIN_SET_LEM]); 5173 5174val SUBSET_MAX_SET = Q.store_thm 5175("SUBSET_MAX_SET", 5176 `!I J. FINITE I /\ FINITE J /\ I SUBSET J ==> MAX_SET I <= MAX_SET J`, 5177 MAP_EVERY Q.X_GEN_TAC [`s1`, `s2`] THEN STRIP_TAC THEN 5178 Q.ASM_CASES_TAC `s1 = {}` THEN1 ASM_SIMP_TAC (srw_ss()) [] THEN 5179 Q.ASM_CASES_TAC `s2 = {}` THEN1 FULL_SIMP_TAC (srw_ss()) [] THEN 5180 METIS_TAC [SUBSET_DEF,MAX_SET_DEF]); 5181 5182val MIN_SET_LEQ_MAX_SET = Q.store_thm 5183("MIN_SET_LEQ_MAX_SET", 5184 `!s. ~(s={}) /\ FINITE s ==> MIN_SET s <= MAX_SET s`, 5185 RW_TAC arith_ss [MIN_SET_DEF] THEN 5186METIS_TAC [FULL_LEAST_INTRO,MAX_SET_DEF,IN_DEF]); 5187 5188val MIN_SET_UNION = Q.store_thm 5189("MIN_SET_UNION", 5190 `!A B. FINITE A /\ FINITE B /\ ~(A={}) /\ ~(B={}) 5191 ==> 5192 (MIN_SET (A UNION B) = MIN (MIN_SET A) (MIN_SET B))`, 5193 let val lem = Q.prove 5194 (`!A. FINITE A ==> 5195 !B. FINITE B /\ ~(A={}) /\ ~(B={}) 5196 ==> (MIN_SET (A UNION B) = MIN (MIN_SET A) (MIN_SET B))`, 5197 SET_INDUCT_TAC THEN RW_TAC (srw_ss()) [] 5198 THEN `?b t. (B = b INSERT t) /\ ~(b IN t)` by METIS_TAC [SET_CASES] 5199 THEN RW_TAC (srw_ss()) [] 5200 THEN `(e INSERT s) UNION (b INSERT t) = e INSERT b INSERT (s UNION t)` 5201 by METIS_TAC [INSERT_UNION,INSERT_UNION_EQ, UNION_COMM, UNION_ASSOC] 5202 THEN POP_ASSUM SUBST_ALL_TAC 5203 THEN `FINITE (s UNION t)` by METIS_TAC [FINITE_INSERT,FINITE_UNION] 5204 THEN RW_TAC (srw_ss()) [MIN_SET_THM] 5205 THEN Cases_on `s={}` THEN RW_TAC (srw_ss()) [MIN_SET_THM] 5206 THEN `b INSERT (s UNION t) = s UNION (b INSERT t)` 5207 by METIS_TAC [INSERT_UNION,INSERT_UNION_EQ, UNION_COMM, UNION_ASSOC] 5208 THEN POP_ASSUM SUBST_ALL_TAC 5209 THEN `MIN_SET (s UNION (b INSERT t)) = MIN (MIN_SET s) (MIN_SET (b INSERT t))` 5210 by METIS_TAC [] THEN POP_ASSUM SUBST_ALL_TAC 5211 THEN `MIN_SET (e INSERT s) = MIN (MIN_SET s) (MIN_SET {e})` 5212 by METIS_TAC [FINITE_SING,NOT_EMPTY_INSERT, 5213 UNION_COMM,INSERT_UNION_EQ,UNION_EMPTY] 5214 THEN RW_TAC (srw_ss()) [MIN_SET_THM, AC MIN_COMM MIN_ASSOC]) 5215 in METIS_TAC [lem] 5216 end);; 5217 5218val MAX_SET_UNION = Q.store_thm 5219("MAX_SET_UNION", 5220 `!A B. FINITE A /\ FINITE B 5221 ==> 5222 (MAX_SET (A UNION B) = MAX (MAX_SET A) (MAX_SET B))`, 5223 Q_TAC SUFF_TAC ` 5224 !A. FINITE A ==> !B. FINITE B ==> 5225 (MAX_SET (A UNION B) = MAX (MAX_SET A) (MAX_SET B)) 5226 ` THEN1 METIS_TAC[] THEN 5227 SET_INDUCT_TAC THEN RW_TAC (srw_ss()) [] 5228 THEN `(B = {}) \/ ?b t. (B = b INSERT t) /\ ~(b IN t)` 5229 by METIS_TAC [SET_CASES] 5230 THEN SRW_TAC [][] 5231 THEN `(e INSERT s) UNION (b INSERT t) = e INSERT b INSERT (s UNION t)` 5232 by SRW_TAC[][EXTENSION,AC DISJ_COMM DISJ_ASSOC] 5233 THEN FULL_SIMP_TAC (srw_ss()) [MAX_SET_THM, AC MAX_COMM MAX_ASSOC]); 5234 5235val set_ss = arith_ss ++ SET_SPEC_ss ++ 5236 rewrites [CARD_INSERT,CARD_EMPTY,FINITE_EMPTY,FINITE_INSERT, 5237 NOT_IN_EMPTY]; 5238 5239(*---------------------------------------------------------------------------*) 5240(* POW s is the powerset of s *) 5241(*---------------------------------------------------------------------------*) 5242 5243val POW_DEF = 5244 new_definition 5245 ("POW_DEF", 5246 ``POW set = {s | s SUBSET set}``); 5247 5248Theorem IN_POW: 5249 !set e. e IN POW set <=> e SUBSET set 5250Proof 5251 RW_TAC bool_ss [POW_DEF,GSPECIFICATION] 5252QED 5253 5254val UNIV_FUN_TO_BOOL = store_thm( 5255 "UNIV_FUN_TO_BOOL", 5256 ``univ(:'a -> bool) = POW univ(:'a)``, 5257 SIMP_TAC (srw_ss()) [EXTENSION, IN_POW]); 5258 5259val SUBSET_POW = Q.store_thm 5260("SUBSET_POW", 5261 `!s1 s2. s1 SUBSET s2 ==> (POW s1) SUBSET (POW s2)`, 5262 RW_TAC set_ss [POW_DEF,SUBSET_DEF]); 5263 5264val SUBSET_INSERT_RIGHT = Q.store_thm 5265("SUBSET_INSERT_RIGHT", 5266 `!e s1 s2. s1 SUBSET s2 ==> s1 SUBSET (e INSERT s2)`, 5267 RW_TAC set_ss [SUBSET_DEF,IN_INSERT]); 5268 5269val SUBSET_DELETE_BOTH = Q.store_thm 5270("SUBSET_DELETE_BOTH", 5271 `!s1 s2 x. s1 SUBSET s2 ==> (s1 DELETE x) SUBSET (s2 DELETE x)`, 5272 RW_TAC set_ss [SUBSET_DEF,SUBSET_DELETE,IN_DELETE]); 5273 5274val POW_EMPTY = store_thm("POW_EMPTY", 5275 ``!s. POW s <> {}``, 5276 SRW_TAC[][EXTENSION,IN_POW] THEN 5277 METIS_TAC[EMPTY_SUBSET]) 5278val _ = export_rewrites["POW_EMPTY"] 5279 5280val EMPTY_IN_POW = store_thm 5281 ("EMPTY_IN_POW", ``!s. {} IN POW s``, 5282 RW_TAC std_ss [IN_POW, EMPTY_SUBSET]); 5283val _ = export_rewrites["EMPTY_IN_POW"]; 5284 5285(*---------------------------------------------------------------------------*) 5286(* Recursion equations for POW *) 5287(*---------------------------------------------------------------------------*) 5288 5289val POW_INSERT = Q.store_thm 5290("POW_INSERT", 5291 `!e s. POW (e INSERT s) = IMAGE ($INSERT e) (POW s) UNION (POW s)`, 5292 RW_TAC set_ss [EXTENSION,IN_UNION,IN_POW] THEN 5293 Cases_on `e IN x` THENL 5294 [EQ_TAC THEN RW_TAC set_ss [] THENL 5295 [DISJ1_TAC 5296 THEN RW_TAC set_ss [IN_IMAGE,IN_POW] 5297 THEN Q.EXISTS_TAC `x DELETE e` 5298 THEN RW_TAC set_ss [INSERT_DELETE] 5299 THEN IMP_RES_TAC SUBSET_DELETE_BOTH 5300 THEN POP_ASSUM (MP_TAC o Q.SPEC `e`) 5301 THEN RW_TAC set_ss [DELETE_INSERT] 5302 THEN METIS_TAC [DELETE_SUBSET,SUBSET_TRANS], 5303 FULL_SIMP_TAC set_ss 5304 [IN_IMAGE,IN_POW,SUBSET_INSERT_RIGHT,INSERT_SUBSET,IN_INSERT], 5305 FULL_SIMP_TAC set_ss [SUBSET_DEF] 5306 THEN METIS_TAC [IN_INSERT]], 5307 RW_TAC set_ss [SUBSET_INSERT] 5308 THEN EQ_TAC THEN RW_TAC set_ss [IN_IMAGE] 5309 THEN METIS_TAC [IN_INSERT]]); 5310 5311val POW_EQNS = Q.store_thm 5312("POW_EQNS", 5313 `(POW {} = {{}} : 'a set set) /\ 5314 (!e:'a. 5315 !s. POW (e INSERT s) = let ps = POW s 5316 in (IMAGE ($INSERT e) ps) UNION ps)`, 5317 CONJ_TAC THENL 5318 [RW_TAC set_ss [POW_DEF,SUBSET_EMPTY,EXTENSION,NOT_IN_EMPTY,IN_INSERT], 5319 METIS_TAC [POW_INSERT,LET_THM]]); 5320 5321val FINITE_POW = Q.store_thm 5322("FINITE_POW", 5323 `!s. FINITE s ==> FINITE (POW s)`, 5324 HO_MATCH_MP_TAC FINITE_INDUCT 5325 THEN CONJ_TAC THENL 5326 [METIS_TAC [POW_EQNS,FINITE_EMPTY,FINITE_INSERT], 5327 RW_TAC set_ss [POW_EQNS,LET_THM,FINITE_UNION,IMAGE_FINITE]]); 5328 5329Theorem FINITE_POW_EQN[simp]: 5330 FINITE (POW s) <=> FINITE s 5331Proof 5332 ���FINITE (POW s) ==> FINITE s��� suffices_by METIS_TAC[FINITE_POW] >> 5333 CONV_TAC CONTRAPOS_CONV >> strip_tac >> 5334 ���?t. INFINITE t /\ t SUBSET POW s��� suffices_by METIS_TAC[SUBSET_FINITE] >> 5335 Q.EXISTS_TAC ���IMAGE (\e. {e}) s��� >> reverse conj_tac 5336 >- simp[SUBSET_DEF, PULL_EXISTS, IN_POW] >> 5337 ���!x y. (\e. {e}) x = (\e. {e}) y <=> x = y��� 5338 suffices_by (strip_tac >> drule INJECTIVE_IMAGE_FINITE >> simp[]) >> 5339 simp[] 5340QED 5341 5342val lem = Q.prove 5343(`!n. 2 * 2**n = 2**n + 2**n`, 5344 RW_TAC arith_ss [EXP]); 5345 5346(*---------------------------------------------------------------------------*) 5347(* Cardinality of the power set of a finite set *) 5348(*---------------------------------------------------------------------------*) 5349 5350val CARD_POW = Q.store_thm 5351("CARD_POW", 5352 `!s. FINITE s ==> (CARD (POW s) = 2 EXP (CARD s))`, 5353 SET_INDUCT_TAC 5354 THEN RW_TAC set_ss [POW_EQNS,LET_THM,EXP] 5355 THEN `FINITE (POW s) /\ 5356 FINITE (IMAGE ($INSERT e) (POW s))` 5357 by METIS_TAC[FINITE_POW,IMAGE_FINITE] 5358 THEN `CARD (IMAGE ($INSERT e) (POW s) UNION POW s) = 5359 CARD (IMAGE ($INSERT e) (POW s)) + CARD(POW s)` 5360 by 5361 (`CARD ((IMAGE ($INSERT e) (POW s)) INTER (POW s)) = 0` 5362 by (RW_TAC set_ss [CARD_EQ_0,INTER_FINITE] THEN 5363 RW_TAC set_ss [EXTENSION,IN_INTER,IN_POW,IN_IMAGE] THEN 5364 RW_TAC set_ss [SUBSET_DEF,IN_INSERT] THEN METIS_TAC[]) 5365 THEN METIS_TAC [CARD_UNION,ADD_CLAUSES]) 5366 THEN POP_ASSUM SUBST_ALL_TAC 5367 THEN Q.PAT_X_ASSUM `X = 2 ** (CARD s)` (ASSUME_TAC o SYM) 5368 THEN ASM_REWRITE_TAC [lem, EQ_ADD_RCANCEL] 5369 THEN `BIJ ($INSERT e) (POW s) (IMAGE ($INSERT e) (POW s))` 5370 by (RW_TAC set_ss [BIJ_DEF,INJ_DEF,SURJ_DEF,IN_IMAGE,IN_POW] 5371 THENL 5372 [METIS_TAC [IN_POW], 5373 `~(e IN x) /\ ~(e IN y)` by METIS_TAC [SUBSET_DEF] 5374 THEN FULL_SIMP_TAC set_ss [EXTENSION, IN_INSERT] 5375 THEN METIS_TAC[], 5376 METIS_TAC [IN_POW],METIS_TAC[]]) 5377 THEN METIS_TAC [FINITE_BIJ_CARD_EQ]); 5378 5379 5380(* ---------------------------------------------------------------------- 5381 Simple lemmas about GSPECIFICATIONs 5382 ---------------------------------------------------------------------- *) 5383 5384val sspec_tac = CONV_TAC (DEPTH_CONV SET_SPEC_CONV) 5385 5386val GSPEC_F = store_thm( 5387 "GSPEC_F", 5388 ``{ x | F} = {}``, 5389 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []); 5390 5391val GSPEC_T = store_thm( 5392 "GSPEC_T", 5393 ``{x | T} = UNIV``, 5394 SRW_TAC [][EXTENSION, IN_UNIV] THEN sspec_tac); 5395 5396val GSPEC_ID = store_thm( 5397 "GSPEC_ID", 5398 ``{x | x IN y} = y``, 5399 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []); 5400 5401val GSPEC_EQ = store_thm( 5402 "GSPEC_EQ", 5403 ``{ x | x = y} = {y}``, 5404 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []); 5405 5406val GSPEC_EQ2 = store_thm( 5407 "GSPEC_EQ2", 5408 ``{ x | y = x} = {y}``, 5409 SRW_TAC [][EXTENSION] THEN sspec_tac THEN EQ_TAC THEN STRIP_TAC THEN 5410 ASM_REWRITE_TAC []); 5411 5412val _ = export_rewrites ["GSPEC_F", "GSPEC_T", "GSPEC_ID", "GSPEC_EQ", 5413 "GSPEC_EQ2"] 5414 5415(* Following rewrites are useful, but probably not suitable for 5416 automatic application. Sadly even those above fail in the presence 5417 of more complicated GSPEC expressions, such as { (x,y) | F }. 5418 5419 We could cope with that particular example using the conditional 5420 rewrite below, but again, this is probably not suitable for 5421 automatic inclusion in rewrite sets *) 5422 5423val GSPEC_F_COND = store_thm( 5424 "GSPEC_F_COND", 5425 ``!f. (!x. ~SND (f x)) ==> (GSPEC f = {})``, 5426 SRW_TAC [][EXTENSION, GSPECIFICATION] THEN 5427 POP_ASSUM (Q.SPEC_THEN `x'` MP_TAC) THEN 5428 Cases_on `f x'` THEN SRW_TAC [][]); 5429 5430val GSPEC_AND = store_thm( 5431 "GSPEC_AND", 5432 ``!P Q. {x | P x /\ Q x} = {x | P x} INTER {x | Q x}``, 5433 SRW_TAC [][EXTENSION] THEN sspec_tac THEN REWRITE_TAC []); 5434 5435val GSPEC_OR = store_thm( 5436 "GSPEC_OR", 5437 ``!P Q. {x | P x \/ Q x} = {x | P x} UNION {x | Q x}``, 5438 SRW_TAC [][EXTENSION, IN_UNION] THEN sspec_tac THEN REWRITE_TAC []); 5439 5440(* ---------------------------------------------------------------------- 5441 partition a set according to an equivalence relation (or at least 5442 a relation that is reflexive, symmetric and transitive over that set) 5443 ---------------------------------------------------------------------- *) 5444 5445val equiv_on_def = new_definition( 5446 "equiv_on_def", 5447 ``(equiv_on) R s <=> 5448 (!x. x IN s ==> R x x) /\ 5449 (!x y. x IN s /\ y IN s ==> (R x y = R y x)) /\ 5450 (!x y z. x IN s /\ y IN s /\ z IN s /\ R x y /\ R y z ==> R x z)``); 5451val _ = set_fixity "equiv_on" (Infix(NONASSOC, 425)) 5452 5453val partition_def = new_definition( 5454 "partition_def", 5455 ``partition R s = 5456 { t | ?x. x IN s /\ (t = { y | y IN s /\ R x y})}``); 5457 5458val BIGUNION_partition = store_thm( 5459 "BIGUNION_partition", 5460 ``R equiv_on s ==> (BIGUNION (partition R s) = s)``, 5461 STRIP_TAC THEN 5462 SRW_TAC [][EXTENSION, IN_BIGUNION, partition_def] THEN 5463 EQ_TAC THEN STRIP_TAC THENL[ 5464 METIS_TAC [equiv_on_def], 5465 Q.EXISTS_TAC `{ y | R x y /\ y IN s}` THEN 5466 `R x x` by METIS_TAC [equiv_on_def] THEN SRW_TAC [][] THEN 5467 METIS_TAC [] 5468 ]); 5469 5470val EMPTY_NOT_IN_partition = store_thm( 5471 "EMPTY_NOT_IN_partition", 5472 ``R equiv_on s ==> ~({} IN partition R s)``, 5473 SRW_TAC [][partition_def, EXTENSION] THEN 5474 METIS_TAC [equiv_on_def]); 5475 5476(* Invocation(s) of PROVE_TAC are slow, but METIS seems to be 5477 possibly slower 5478*) 5479val partition_elements_disjoint = store_thm( 5480 "partition_elements_disjoint", 5481 ``R equiv_on s ==> 5482 !t1 t2. t1 IN partition R s /\ t2 IN partition R s /\ ~(t1 = t2) ==> 5483 DISJOINT t1 t2``, 5484 STRIP_TAC THEN SIMP_TAC (srw_ss()) [partition_def] THEN 5485 REPEAT GEN_TAC THEN 5486 DISCH_THEN (CONJUNCTS_THEN2 5487 (Q.X_CHOOSE_THEN `a` MP_TAC) 5488 (CONJUNCTS_THEN2 5489 (Q.X_CHOOSE_THEN `b` MP_TAC) MP_TAC)) THEN 5490 MAP_EVERY Q.ID_SPEC_TAC [`t1`, `t2`] THEN SIMP_TAC (srw_ss()) [] THEN 5491 SRW_TAC [][DISJOINT_DEF] THEN 5492 SIMP_TAC (srw_ss()) [EXTENSION] THEN 5493 Q.X_GEN_TAC `c` THEN Cases_on `c IN s` THEN SRW_TAC [][] THEN 5494 Cases_on `R a c` THEN SRW_TAC [][] THEN 5495 STRIP_TAC THEN 5496 `R a b` by PROVE_TAC [equiv_on_def] THEN 5497 Q.PAT_X_ASSUM `S1 <> S2` MP_TAC THEN SRW_TAC [][] THEN 5498 SRW_TAC [][EXTENSION] THEN PROVE_TAC [equiv_on_def]); 5499 5500val partition_elements_interrelate = store_thm( 5501 "partition_elements_interrelate", 5502 ``R equiv_on s ==> !t. t IN partition R s ==> 5503 !x y. x IN t /\ y IN t ==> R x y``, 5504 SIMP_TAC (srw_ss()) [partition_def, GSYM LEFT_FORALL_IMP_THM] THEN 5505 PROVE_TAC [equiv_on_def]); 5506 5507val partition_SUBSET = Q.store_thm 5508("partition_SUBSET", 5509 `!R s t. t IN partition R s ==> t SUBSET s`, 5510 SRW_TAC [][partition_def, EXTENSION, EQ_IMP_THM] THEN 5511 METIS_TAC [SUBSET_DEF]); 5512 5513val FINITE_partition = Q.store_thm ( 5514 "FINITE_partition", 5515 `!R s. FINITE s ==> 5516 FINITE (partition R s) /\ 5517 !t. t IN partition R s ==> FINITE t`, 5518 REPEAT GEN_TAC THEN STRIP_TAC THEN 5519 `!t. t IN partition R s ==> t SUBSET s` by METIS_TAC [partition_SUBSET] THEN 5520 `!t. t IN partition R s ==> t IN POW s` by SRW_TAC [][POW_DEF] THEN 5521 METIS_TAC [FINITE_POW, SUBSET_FINITE, SUBSET_DEF]); 5522 5523val partition_CARD = Q.store_thm 5524("partition_CARD", 5525 `!R s. R equiv_on s /\ FINITE s 5526 ==> 5527 (CARD s = SUM_IMAGE CARD (partition R s))`, 5528METIS_TAC [FINITE_partition, BIGUNION_partition, DISJ_BIGUNION_CARD, 5529 partition_elements_disjoint, FINITE_BIGUNION, partition_def]); 5530 5531(* ---------------------------------------------------------------------- 5532 Assert a predicate on all pairs of elements in a set. 5533 Take the RC of the P argument to consider only pairs of distinct elements. 5534 ---------------------------------------------------------------------- *) 5535 5536val pairwise_def = new_definition( 5537 "pairwise_def", 5538 ``pairwise P s = !e1 e2. e1 IN s /\ e2 IN s ==> P e1 e2``); 5539 5540val pairwise_UNION = Q.store_thm( 5541"pairwise_UNION", 5542`pairwise R (s1 UNION s2) <=> 5543 pairwise R s1 /\ pairwise R s2 /\ (!x y. x IN s1 /\ y IN s2 ==> R x y /\ R y x)`, 5544SRW_TAC [boolSimps.DNF_ss][pairwise_def] THEN METIS_TAC []); 5545 5546val pairwise_SUBSET = Q.store_thm( 5547"pairwise_SUBSET", 5548`!R s t. pairwise R t /\ s SUBSET t ==> pairwise R s`, 5549SRW_TAC [][SUBSET_DEF,pairwise_def]); 5550 5551 5552(* ---------------------------------------------------------------------- 5553 A proof of Koenig's Lemma 5554 ---------------------------------------------------------------------- *) 5555 5556(* a counting exercise for R-trees. If x0 has finitely many successors, and 5557 each of these successors has finite trees underneath, then x0's tree is 5558 also finite *) 5559val KL_lemma1 = prove( 5560 ``FINITE { x | R x0 x} /\ 5561 (!y. R x0 y ==> FINITE { x | RTC R y x }) ==> 5562 FINITE { x | RTC R x0 x}``, 5563 REPEAT STRIP_TAC THEN 5564 `{ x | RTC R x0 x} = 5565 x0 INSERT BIGUNION (IMAGE (\x. {y | RTC R x y}) {x | R x0 x})` 5566 by (REWRITE_TAC [EXTENSION] THEN 5567 SRW_TAC [][GSYM RIGHT_EXISTS_AND_THM, IN_BIGUNION, IN_IMAGE, 5568 GSPECIFICATION] THEN 5569 PROVE_TAC [relationTheory.RTC_CASES1]) THEN 5570 POP_ASSUM SUBST_ALL_TAC THEN SRW_TAC [][IN_IMAGE] THENL [ 5571 SRW_TAC [][IMAGE_FINITE, IN_IMAGE, GSPECIFICATION], 5572 RES_TAC 5573 ]); 5574 5575 5576(*---------------------------------------------------------------------------*) 5577(* Effectively taking the contrapositive of the above, saying that if R is *) 5578(* finitely branching, and we're on top of an infinite R tree, then one of *) 5579(* the immediate children is on top of an infinite R tree *) 5580(*---------------------------------------------------------------------------*) 5581 5582val KL_lemma2 = prove( 5583 ``(!x. FINITE {y | R x y}) ==> 5584 !y. ~ FINITE {x | RTC R y x} ==> ?z. R y z /\ ~FINITE { x | RTC R z x}``, 5585 METIS_TAC [KL_lemma1]); 5586 5587(*---------------------------------------------------------------------------*) 5588(* Now throw in the unavoidable use of the axiom of choice, and say that *) 5589(* there's a function to do this for us. *) 5590(*---------------------------------------------------------------------------*) 5591 5592val KL_lemma3 = 5593 CONV_RULE (ONCE_DEPTH_CONV RIGHT_IMP_EXISTS_CONV THENC 5594 ONCE_DEPTH_CONV SKOLEM_CONV) KL_lemma2 5595 5596val KoenigsLemma = store_thm( 5597 "KoenigsLemma", 5598 ``!R. (!x. FINITE {y | R x y}) ==> 5599 !x. ~FINITE {y | RTC R x y} ==> 5600 ?f. (f 0 = x) /\ !n. R (f n) (f (SUC n))``, 5601 REPEAT STRIP_TAC THEN 5602 `?g. !y. ~FINITE { x | RTC R y x} ==> 5603 R y (g y) /\ ~FINITE {x | RTC R (g y) x}` 5604 by METIS_TAC [KL_lemma3] THEN 5605 Q.SPECL_THEN [`x`, `\n r. g r`] 5606 (Q.X_CHOOSE_THEN `f` STRIP_ASSUME_TAC o BETA_RULE) 5607 (TypeBase.axiom_of ``:num``) THEN 5608 Q.EXISTS_TAC `f` THEN ASM_REWRITE_TAC [] THEN 5609 Q_TAC SUFF_TAC 5610 `!n. R (f n) (g (f n)) /\ ~FINITE { x | RTC R (f n) x}` THEN1 5611 METIS_TAC [] THEN 5612 Induct THEN METIS_TAC []); 5613 5614val KoenigsLemma_WF = store_thm( 5615 "KoenigsLemma_WF", 5616 ``!R. (!x. FINITE {y | R x y}) /\ WF (inv R) ==> !x. FINITE {y | RTC R x y}``, 5617 SRW_TAC [][prim_recTheory.WF_IFF_WELLFOUNDED, 5618 prim_recTheory.wellfounded_def, 5619 relationTheory.inv_DEF] THEN 5620 METIS_TAC [KoenigsLemma]); 5621 5622Theorem PSUBSET_EQN: 5623 !s1 s2. s1 PSUBSET s2 <=> s1 SUBSET s2 /\ ~(s2 SUBSET s1) 5624Proof PROVE_TAC [PSUBSET_DEF,SET_EQ_SUBSET] 5625QED 5626 5627val PSUBSET_SUBSET_TRANS = Q.store_thm 5628("PSUBSET_SUBSET_TRANS", 5629 `!s t u. s PSUBSET t /\ t SUBSET u ==> s PSUBSET u`, 5630 PROVE_TAC [SUBSET_DEF,PSUBSET_EQN]); 5631 5632val SUBSET_PSUBSET_TRANS = Q.store_thm 5633("SUBSET_PSUBSET_TRANS", 5634 `!s t u. s SUBSET t /\ t PSUBSET u ==> s PSUBSET u`, 5635 PROVE_TAC [SUBSET_DEF,PSUBSET_EQN]); 5636 5637val CROSS_EQNS = Q.store_thm 5638("CROSS_EQNS", 5639 `!(s1:'a set) (s2:'b set). 5640 (({}:'a set) CROSS s2 = ({}:('a#'b) set)) /\ 5641 ((a INSERT s1) CROSS s2 = (IMAGE (\y.(a,y)) s2) UNION (s1 CROSS s2))`, 5642RW_TAC set_ss [CROSS_EMPTY,Once CROSS_INSERT_LEFT] 5643 THEN MATCH_MP_TAC (PROVE [] (Term`(a=b) ==> (f a c = f b c)`)) 5644 THEN RW_TAC set_ss [CROSS_DEF,IMAGE_DEF,EXTENSION] 5645 THEN METIS_TAC [ABS_PAIR_THM,IN_SING,FST,SND]); 5646 5647val count_EQN = Q.store_thm 5648("count_EQN", 5649 `!n. count n = if n = 0 then {} else 5650 let p = PRE n in p INSERT (count p)`, 5651 REWRITE_TAC [count_def] 5652 THEN Induct 5653 THEN RW_TAC arith_ss [GSPEC_F] 5654 THEN RW_TAC set_ss [EXTENSION,IN_SING,IN_INSERT]); 5655 5656(* Theorems about countability added by Scott Owens on 2009-03-20, plus a few 5657* misc. theorems *) 5658 5659fun FSTAC thms = FULL_SIMP_TAC (srw_ss()) thms; 5660fun RWTAC thms = SRW_TAC [] thms; 5661 5662Theorem UNIQUE_MEMBER_SING: 5663 !x s. x IN s /\ (!y. y IN s ==> (x = y)) <=> (s = {x}) 5664Proof 5665 SRW_TAC [] [EXTENSION] THEN METIS_TAC [] 5666QED 5667 5668val inj_surj = Q.store_thm ("inj_surj", 5669`!f s t. INJ f s t ==> (s = {}) \/ ?f'. SURJ f' t s`, 5670RWTAC [INJ_DEF, SURJ_DEF, tautLib.TAUT ���a \/ b <=> ~a ==> b���] THEN 5671`!x. ?y. y IN s /\ (x IN IMAGE f s ==> (f y = x))` 5672 by (RWTAC [] THEN 5673 Cases_on `x IN IMAGE f s` THEN 5674 FSTAC [IMAGE_DEF] THEN1 5675 METIS_TAC [] THEN 5676 Q.EXISTS_TAC `CHOICE s` THEN 5677 RWTAC [CHOICE_DEF] THEN 5678 METIS_TAC []) THEN 5679 FSTAC [SKOLEM_THM, IN_IMAGE] THEN 5680 METIS_TAC []); 5681 5682val infinite_rest = Q.store_thm ("infinite_rest", 5683`!s. INFINITE s ==> INFINITE (REST s)`, 5684RWTAC [] THEN 5685CCONTR_TAC THEN 5686FSTAC [REST_DEF]); 5687 5688val chooser_def = TotalDefn.Define ` 5689 (chooser s 0 = CHOICE s) /\ 5690 (chooser s (SUC n) = chooser (REST s) n)`; 5691 5692val chooser_lem1 = Q.prove ( 5693`!n s t. INFINITE s /\ s SUBSET t ==> chooser s n IN t`, 5694Induct THEN 5695RWTAC [chooser_def, SUBSET_DEF] THENL [ 5696 `s <> {}` by (RWTAC [EXTENSION] THEN METIS_TAC [INFINITE_INHAB]) THEN 5697 METIS_TAC [CHOICE_DEF], 5698 `REST s SUBSET s` by RWTAC [REST_SUBSET] THEN 5699 METIS_TAC [infinite_rest] 5700]); 5701 5702val chooser_lem2 = Q.prove ( 5703`!n s. INFINITE s ==> chooser (REST s) n <> CHOICE s`, 5704RWTAC [] THEN 5705IMP_RES_TAC infinite_rest THEN 5706`chooser (REST s) n IN (REST s)` 5707 by METIS_TAC [chooser_lem1, SUBSET_REFL] THEN 5708FSTAC [REST_DEF, IN_DELETE]); 5709 5710val chooser_lem3 = Q.prove ( 5711`!x y s. INFINITE s /\ (chooser s x = chooser s y) ==> (x = y)`, 5712Induct_on `x` THEN 5713RWTAC [chooser_def] THEN 5714Cases_on `y` THEN 5715FSTAC [chooser_def] THEN 5716RWTAC [] THEN 5717METIS_TAC [chooser_lem2, infinite_rest]); 5718 5719val infinite_num_inj_lem = Q.prove ( 5720`!s. FINITE s ==> ~?f. INJ f (UNIV:num set) s`, 5721HO_MATCH_MP_TAC FINITE_INDUCT THEN 5722RWTAC [] THEN 5723FSTAC [INJ_DEF] THEN 5724CCONTR_TAC THEN 5725FSTAC [IN_UNIV] THEN 5726Q.PAT_X_ASSUM `!f. (?x. f x NOTIN s) \/ P f` MP_TAC THEN 5727RWTAC [] THEN 5728Cases_on `?y. f y = e` THEN 5729FSTAC [] THEN 5730RWTAC [] THENL [ 5731 Q.EXISTS_TAC `\x. if x < y then f x else f (SUC x)` THEN 5732 RWTAC [] THEN 5733 FSTAC [DISJ_EQ_IMP] THEN 5734 RWTAC [] THENL [ 5735 `x <> y` by DECIDE_TAC THEN METIS_TAC [], 5736 `SUC x <> y` by DECIDE_TAC THEN METIS_TAC [], 5737 `x = SUC y'` by METIS_TAC [] THEN DECIDE_TAC, 5738 `SUC x = y'` by METIS_TAC [] THEN DECIDE_TAC, 5739 `SUC x = SUC y'` by METIS_TAC [] THEN DECIDE_TAC 5740 ], 5741 METIS_TAC [] 5742]); 5743 5744val infinite_num_inj = Q.store_thm ("infinite_num_inj", 5745`!s. INFINITE s = ?f. INJ f (UNIV:num set) s`, 5746RWTAC [] THEN 5747EQ_TAC THEN 5748RWTAC [] THENL 5749[Q.EXISTS_TAC `chooser s` THEN 5750 RWTAC [INJ_DEF] THEN 5751 METIS_TAC [chooser_lem1, chooser_lem3, SUBSET_REFL], 5752 METIS_TAC [infinite_num_inj_lem]]); 5753 5754val countable_def = TotalDefn.Define ` 5755 countable s = ?f. INJ f s (UNIV:num set)`; 5756 5757val countable_image_nats = store_thm( "countable_image_nats", 5758 ``countable (IMAGE f univ(:num))``, SIMP_TAC 5759 (srw_ss())[countable_def] THEN METIS_TAC[SURJ_IMAGE, SURJ_INJ_INV]); 5760 val _ = export_rewrites ["countable_image_nats"] 5761 5762Theorem countable_surj: 5763 !s. countable s <=> (s = {}) \/ ?f. SURJ f (UNIV:num set) s 5764Proof 5765RWTAC [countable_def] THEN 5766EQ_TAC THEN 5767RWTAC [] THENL 5768[METIS_TAC [inj_surj], 5769 RWTAC [INJ_DEF], 5770 Cases_on `s = {}` THEN 5771 FSTAC [INJ_DEF, SURJ_DEF] THEN 5772 METIS_TAC []] 5773QED 5774 5775val num_countable = Q.store_thm ("num_countable", 5776`countable (UNIV:num set)`, 5777RWTAC [countable_def, INJ_DEF] THEN 5778Q.EXISTS_TAC `\x.x` THEN 5779RWTAC []); 5780 5781val INJ_SUBSET = Q.prove ( 5782`!f s t s'. INJ f s t /\ s' SUBSET s ==> INJ f s' t`, 5783RWTAC [INJ_DEF, SUBSET_DEF]); 5784 5785val subset_countable = Q.store_thm ("subset_countable", 5786`!s t. countable s /\ t SUBSET s ==> countable t`, 5787RWTAC [countable_def] THEN 5788METIS_TAC [INJ_SUBSET]); 5789 5790val image_countable = Q.store_thm ("image_countable", 5791`!f s. countable s ==> countable (IMAGE f s)`, 5792RWTAC [countable_surj, SURJ_DEF] THEN 5793Cases_on `s = {}` THEN 5794FSTAC [IN_IMAGE, IN_UNIV] THEN 5795Q.EXISTS_TAC `f o f'` THEN 5796RWTAC [] THEN 5797METIS_TAC []); 5798 5799(* an alternative definition from util_probTheory *) 5800val COUNTABLE_ALT = store_thm ("COUNTABLE_ALT", 5801 ``!s. countable s = ?f. !x : 'a. x IN s ==> ?n :num. f n = x``, 5802 GEN_TAC 5803 >> EQ_TAC (* 2 sub-goals here *) 5804 >| [ (* goal 1 (of 2) *) 5805 REWRITE_TAC [countable_surj] \\ 5806 rpt STRIP_TAC >- RW_TAC std_ss [NOT_IN_EMPTY] \\ 5807 Q.EXISTS_TAC `f` \\ 5808 POP_ASSUM MP_TAC \\ 5809 REWRITE_TAC [SURJ_DEF] >> METIS_TAC [], 5810 (* goal 2 (of 2) *) 5811 rpt STRIP_TAC \\ 5812 ASSUME_TAC num_countable \\ 5813 `countable (IMAGE f (UNIV :num set))` by PROVE_TAC [image_countable] \\ 5814 ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:num``] IN_UNIV) \\ 5815 Know `s SUBSET (IMAGE f (UNIV :num set))` >| (* 2 sub-goals here *) 5816 [ (* goal 2.1 (of 2) *) 5817 REWRITE_TAC [SUBSET_DEF, IN_IMAGE] \\ 5818 rpt STRIP_TAC >> PROVE_TAC [], 5819 (* goal 2.2 (of 2) *) 5820 PROVE_TAC [subset_countable] ] ]); 5821 5822val COUNTABLE_SUBSET = store_thm (* from util_prob *) 5823 ("COUNTABLE_SUBSET", 5824 ``!s t. s SUBSET t /\ countable t ==> countable s``, 5825 RW_TAC std_ss [COUNTABLE_ALT, SUBSET_DEF] 5826 >> Q.EXISTS_TAC `f` 5827 >> PROVE_TAC []); 5828 5829val finite_countable = store_thm (* from util_prob *) 5830 ("finite_countable", 5831 ``!s. FINITE s ==> countable s``, 5832 REWRITE_TAC [COUNTABLE_ALT] 5833 >> HO_MATCH_MP_TAC FINITE_INDUCT 5834 >> RW_TAC std_ss [NOT_IN_EMPTY] 5835 >> Q.EXISTS_TAC `\n. if n = 0 then e else f (n - 1)` 5836 >> RW_TAC std_ss [IN_INSERT] >- PROVE_TAC [] 5837 >> Q.PAT_X_ASSUM `!x. P x` (MP_TAC o Q.SPEC `x`) 5838 >> RW_TAC std_ss [] 5839 >> Q.EXISTS_TAC `SUC n` 5840 >> RW_TAC std_ss [SUC_SUB1]); 5841 5842val COUNTABLE_COUNT = store_thm (* from util_prob *) 5843 ("COUNTABLE_COUNT", 5844 ``!n. countable (count n)``, 5845 PROVE_TAC [FINITE_COUNT, finite_countable]); 5846 5847val COUNTABLE_NUM = store_thm (* from util_prob *) 5848 ("COUNTABLE_NUM", 5849 ``!s :num -> bool. countable s``, 5850 RW_TAC std_ss [COUNTABLE_ALT] 5851 >> Q.EXISTS_TAC `I` 5852 >> RW_TAC std_ss [combinTheory.I_THM]); 5853 5854val COUNTABLE_IMAGE_NUM = store_thm (* from util_prob *) 5855 ("COUNTABLE_IMAGE_NUM", 5856 ``!f :num -> 'a. !s. countable (IMAGE f s)``, 5857 PROVE_TAC [COUNTABLE_NUM, image_countable]); 5858 5859open numpairTheory 5860 5861val num_to_pair_def = TotalDefn.Define `num_to_pair n = (nfst n, nsnd n)` 5862val pair_to_num_def = TotalDefn.Define `pair_to_num (m,n) = m *, n` 5863 5864val pair_to_num_formula = Q.store_thm ("pair_to_num_formula", 5865 `!x y. pair_to_num (x, y) = (x + y + 1) * (x + y) DIV 2 + y`, 5866 SRW_TAC [][pair_to_num_def, tri_formula, npair_def, MULT_COMM]); 5867 5868val pair_to_num_inv = Q.store_thm ("pair_to_num_inv", 5869 `(!x. pair_to_num (num_to_pair x) = x) /\ 5870 (!x y. num_to_pair (pair_to_num (x, y)) = (x, y))`, 5871 SRW_TAC [][pair_to_num_def, num_to_pair_def]); 5872 5873val num_cross_countable = Q.prove ( 5874 `countable (UNIV:num set CROSS UNIV:num set)`, 5875 RWTAC [countable_surj, SURJ_DEF, CROSS_DEF] THEN 5876 METIS_TAC [PAIR, pair_to_num_inv]); 5877 5878val cross_countable = Q.store_thm ("cross_countable", 5879`!s t. countable s /\ countable t ==> countable (s CROSS t)`, 5880RWTAC [] THEN 5881POP_ASSUM (MP_TAC o SIMP_RULE bool_ss [countable_surj]) THEN 5882POP_ASSUM (MP_TAC o SIMP_RULE bool_ss [countable_surj]) THEN 5883RWTAC [SURJ_DEF] THEN 5884RWTAC [CROSS_EMPTY, FINITE_EMPTY, finite_countable] THEN 5885`s CROSS t = IMAGE (\(x, y). (f x, f' y)) (UNIV:num set CROSS UNIV:num set)` 5886 by (RWTAC [CROSS_DEF, IMAGE_DEF, EXTENSION] THEN 5887 EQ_TAC THEN 5888 RWTAC [] THENL 5889 [Cases_on `x` THEN 5890 FSTAC [] THEN 5891 RES_TAC THEN 5892 Q.EXISTS_TAC `(y', y)` THEN 5893 RWTAC [], 5894 Cases_on `x'` THEN 5895 FSTAC [], 5896 Cases_on `x'` THEN 5897 FSTAC []]) THEN 5898METIS_TAC [num_cross_countable, image_countable]); 5899 5900val inter_countable = Q.store_thm ("inter_countable", 5901`!s t. countable s \/ countable t ==> countable (s INTER t)`, 5902METIS_TAC [INTER_SUBSET, subset_countable]); 5903 5904val inj_countable = Q.store_thm ("inj_countable", 5905`!f s t. countable t /\ INJ f s t ==> countable s`, 5906RWTAC [countable_def, INJ_DEF] THEN 5907Q.EXISTS_TAC `f' o f` THEN 5908RWTAC []); 5909 5910val bigunion_countable = Q.store_thm ("bigunion_countable", 5911`!s. countable s /\ (!x. x IN s ==> countable x) ==> countable (BIGUNION s)`, 5912RWTAC [] THEN 5913`!x. ?f. x IN s ==> INJ f x (UNIV:num set)` 5914 by (RWTAC [RIGHT_EXISTS_IMP_THM] THEN 5915 FSTAC [countable_def]) THEN 5916`!a. ?x. a IN BIGUNION s ==> a IN x /\ x IN s` 5917 by (RWTAC [IN_BIGUNION] THEN 5918 METIS_TAC []) THEN 5919FSTAC [SKOLEM_THM] THEN 5920`?g. INJ g s (UNIV:num set)` 5921 by (FSTAC [countable_def] THEN 5922 METIS_TAC []) THEN 5923`INJ (\a. (g (f' a), f (f' a) a)) (BIGUNION s) 5924 (UNIV:num set CROSS UNIV:num set)` 5925 by (FSTAC [INJ_DEF] THEN 5926 RWTAC [] THEN 5927 `f' a = f' a'` by METIS_TAC [] THEN 5928 FSTAC [] THEN 5929 METIS_TAC []) THEN 5930METIS_TAC [inj_countable, num_cross_countable]); 5931 5932val union_countable = Q.store_thm ("union_countable", 5933`!s t. countable s /\ countable t ==> countable (s UNION t)`, 5934RWTAC [] THEN 5935`!x. x IN {s; t} ==> countable x` by ASM_SIMP_TAC (srw_ss() ++ DNF_ss) [] THEN 5936`FINITE {s; t}` by RWTAC [] THEN 5937`s UNION t = BIGUNION {s; t}` 5938 by (RWTAC [EXTENSION, IN_UNION, IN_BIGUNION] THEN 5939 METIS_TAC []) THEN 5940METIS_TAC [bigunion_countable, finite_countable]); 5941 5942val union_countable_IFF = store_thm( 5943 "union_countable_IFF", 5944 ``countable (s UNION t) <=> countable s /\ countable t``, 5945 METIS_TAC [union_countable, SUBSET_UNION, subset_countable]); 5946val _ = export_rewrites ["union_countable_IFF"] 5947 5948val inj_image_countable_IFF = store_thm( 5949 "inj_image_countable_IFF", 5950 ``INJ f s (IMAGE f s) ==> (countable (IMAGE f s) <=> countable s)``, 5951 SRW_TAC[][EQ_IMP_THM, image_countable] THEN 5952 METIS_TAC[countable_def, INJ_COMPOSE]); 5953 5954val pow_no_surj = Q.store_thm ("pow_no_surj", 5955`!s. ~?f. SURJ f s (POW s)`, 5956RWTAC [SURJ_DEF, POW_DEF, DISJ_EQ_IMP] THEN 5957Q.EXISTS_TAC `{a | a IN s /\ a NOTIN f a}` THEN 5958RWTAC [EXTENSION, SUBSET_DEF] THEN 5959METIS_TAC []); 5960 5961val infinite_pow_uncountable = Q.store_thm ("infinite_pow_uncountable", 5962`!s. INFINITE s ==> ~countable (POW s)`, 5963RWTAC [countable_surj, infinite_num_inj] THEN 5964IMP_RES_TAC inj_surj THEN 5965FSTAC [UNIV_NOT_EMPTY] THEN 5966METIS_TAC [pow_no_surj, SURJ_COMPOSE]); 5967 5968val countable_Usum = store_thm( 5969 "countable_Usum", 5970 ``countable univ(:'a + 'b) <=> 5971 countable univ(:'a) /\ countable univ(:'b)``, 5972 SRW_TAC [][SUM_UNIV, inj_image_countable_IFF, INJ_INL, INJ_INR]); 5973val _ = export_rewrites ["countable_Usum"] 5974 5975val countable_EMPTY = store_thm( 5976 "countable_EMPTY", 5977 ``countable {}``, 5978 SIMP_TAC (srw_ss()) [countable_def, INJ_EMPTY]); 5979val _ = export_rewrites ["countable_EMPTY"] 5980 5981val countable_INSERT = store_thm( 5982 "countable_INSERT", 5983 ``countable (x INSERT s) <=> countable s``, 5984 Cases_on `x IN s` THEN1 ASM_SIMP_TAC (srw_ss()) [ABSORPTION_RWT] THEN 5985 SIMP_TAC (srw_ss()) [countable_def] THEN EQ_TAC THEN 5986 DISCH_THEN (Q.X_CHOOSE_THEN `f` ASSUME_TAC) THENL [ 5987 Q.EXISTS_TAC `f` THEN MATCH_MP_TAC INJ_SUBSET THEN 5988 Q.EXISTS_TAC `x INSERT s` THEN ASM_SIMP_TAC (srw_ss()) [SUBSET_DEF], 5989 Q.EXISTS_TAC `\y. if y IN s then f y + 1 else 0` THEN 5990 FULL_SIMP_TAC (srw_ss() ++ DNF_ss) [INJ_DEF] 5991 ]); 5992val _ = export_rewrites ["countable_INSERT"] 5993 5994val cross_countable_IFF = store_thm( 5995 "cross_countable_IFF", 5996 ``countable (s CROSS t) <=> 5997 (s = {}) \/ (t = {}) \/ countable s /\ countable t``, 5998 SIMP_TAC (srw_ss()) [EQ_IMP_THM, DISJ_IMP_THM, cross_countable] THEN 5999 STRIP_TAC THEN 6000 `(s = {}) \/ ?a s0. (s = a INSERT s0) /\ a NOTIN s0` 6001 by METIS_TAC [SET_CASES] THEN1 SRW_TAC [][] THEN 6002 `(t = {}) \/ ?b t0. (t = b INSERT t0) /\ b NOTIN t0` 6003 by METIS_TAC [SET_CASES] THEN1 SRW_TAC [][] THEN 6004 `?fg:'a # 'b -> num. 6005 !xy1 xy2. xy1 IN s CROSS t /\ xy2 IN s CROSS t ==> 6006 ((fg xy1 = fg xy2) <=> (xy1 = xy2))` 6007 by (Q.UNDISCH_THEN `countable (s CROSS t)` MP_TAC THEN 6008 SIMP_TAC bool_ss [countable_def, INJ_DEF, IN_UNIV] THEN 6009 METIS_TAC[]) THEN 6010 `countable s` 6011 by (SIMP_TAC (srw_ss()) [countable_def] THEN 6012 Q.EXISTS_TAC `\x. fg (x,b)` THEN 6013 SIMP_TAC (srw_ss()) [INJ_DEF] THEN 6014 MAP_EVERY Q.X_GEN_TAC [`a1`, `a2`] THEN 6015 STRIP_TAC THEN 6016 FIRST_X_ASSUM (Q.SPECL_THEN [`(a1,b)`, `(a2,b)`] MP_TAC) THEN 6017 NTAC 2 (POP_ASSUM MP_TAC) THEN 6018 ASM_SIMP_TAC (srw_ss()) []) THEN 6019 `countable t` 6020 by (SIMP_TAC (srw_ss()) [countable_def] THEN 6021 Q.EXISTS_TAC `\y. fg (a,y)` THEN 6022 SIMP_TAC (srw_ss()) [INJ_DEF] THEN 6023 MAP_EVERY Q.X_GEN_TAC [`b1`, `b2`] THEN 6024 STRIP_TAC THEN 6025 FIRST_X_ASSUM (Q.SPECL_THEN [`(a,b1)`, `(a,b2)`] MP_TAC) THEN 6026 NTAC 2 (POP_ASSUM MP_TAC) THEN 6027 ASM_SIMP_TAC (srw_ss()) []) THEN 6028 SRW_TAC [][]); 6029 6030val countable_Uprod = store_thm( 6031 "countable_Uprod", 6032 ``countable univ(:'a # 'b) <=> countable univ(:'a) /\ countable univ(:'b)``, 6033 SIMP_TAC (srw_ss()) [CROSS_UNIV, cross_countable_IFF]); 6034 6035val EXPLICIT_ENUMERATE_MONO = store_thm (* from util_prob *) 6036 ("EXPLICIT_ENUMERATE_MONO", 6037 ``!n s. FUNPOW REST n s SUBSET s``, 6038 Induct >- RW_TAC std_ss [FUNPOW, SUBSET_DEF] 6039 >> RW_TAC std_ss [FUNPOW_SUC] 6040 >> PROVE_TAC [SUBSET_TRANS, REST_SUBSET]); 6041 6042val EXPLICIT_ENUMERATE_NOT_EMPTY = store_thm (* from util_prob *) 6043 ("EXPLICIT_ENUMERATE_NOT_EMPTY", 6044 ``!n s. INFINITE s ==> ~(FUNPOW REST n s = {})``, 6045 REWRITE_TAC [] 6046 >> Induct >- (RW_TAC std_ss [FUNPOW] >> PROVE_TAC [FINITE_EMPTY]) 6047 >> RW_TAC std_ss [FUNPOW] 6048 >> Q.PAT_X_ASSUM `!s. P s` (MP_TAC o Q.SPEC `REST s`) 6049 >> PROVE_TAC [FINITE_REST_EQ]); 6050 6051val INFINITE_EXPLICIT_ENUMERATE = store_thm (* from util_prob *) 6052 ("INFINITE_EXPLICIT_ENUMERATE", 6053 ``!s. INFINITE s ==> INJ (\n :num. CHOICE (FUNPOW REST n s)) UNIV s``, 6054 RW_TAC std_ss [INJ_DEF, IN_UNIV] 6055 >- (Suff `CHOICE (FUNPOW REST n s) IN FUNPOW REST n s` 6056 >- PROVE_TAC [SUBSET_DEF, EXPLICIT_ENUMERATE_MONO] 6057 >> RW_TAC std_ss [GSYM CHOICE_DEF, EXPLICIT_ENUMERATE_NOT_EMPTY]) 6058 >> rpt (POP_ASSUM MP_TAC) 6059 >> Q.SPEC_TAC (`s`, `s`) 6060 >> Q.SPEC_TAC (`n'`, `y`) 6061 >> Q.SPEC_TAC (`n`, `x`) 6062 >> (Induct >> Cases) >| 6063 [PROVE_TAC [], 6064 rpt STRIP_TAC 6065 >> Suff `~(CHOICE (FUNPOW REST 0 s) IN FUNPOW REST (SUC n) s)` 6066 >- (RW_TAC std_ss [] 6067 >> MATCH_MP_TAC CHOICE_DEF 6068 >> PROVE_TAC [EXPLICIT_ENUMERATE_NOT_EMPTY]) 6069 >> POP_ASSUM K_TAC 6070 >> RW_TAC std_ss [FUNPOW] 6071 >> Suff `~(CHOICE s IN REST s)` 6072 >- PROVE_TAC [SUBSET_DEF, EXPLICIT_ENUMERATE_MONO] 6073 >> PROVE_TAC [CHOICE_NOT_IN_REST], 6074 rpt STRIP_TAC 6075 >> POP_ASSUM (ASSUME_TAC o ONCE_REWRITE_RULE [EQ_SYM_EQ]) 6076 >> Suff `~(CHOICE (FUNPOW REST 0 s) IN FUNPOW REST (SUC x) s)` 6077 >- (RW_TAC std_ss [] 6078 >> MATCH_MP_TAC CHOICE_DEF 6079 >> PROVE_TAC [EXPLICIT_ENUMERATE_NOT_EMPTY]) 6080 >> POP_ASSUM K_TAC 6081 >> RW_TAC std_ss [FUNPOW] 6082 >> Suff `~(CHOICE s IN REST s)` 6083 >- PROVE_TAC [SUBSET_DEF, EXPLICIT_ENUMERATE_MONO] 6084 >> PROVE_TAC [CHOICE_NOT_IN_REST], 6085 RW_TAC std_ss [FUNPOW] 6086 >> Q.PAT_X_ASSUM `!y. P y` (MP_TAC o Q.SPECL [`n`, `REST s`]) 6087 >> PROVE_TAC [FINITE_REST_EQ]]); 6088 6089val BIJ_NUM_COUNTABLE = store_thm (* from util_prob *) 6090 ("BIJ_NUM_COUNTABLE", 6091 ``!s. (?f :num -> 'a. BIJ f UNIV s) ==> countable s``, 6092 RW_TAC std_ss [COUNTABLE_ALT, BIJ_DEF, SURJ_DEF, IN_UNIV] 6093 >> PROVE_TAC []); 6094 6095(** enumerate functions as BIJ from univ(:num) to countable sets, from util_prob *) 6096val enumerate_def = new_definition ("enumerate_def", 6097 ``enumerate s = @f :num -> 'a. BIJ f UNIV s``); 6098 6099val ENUMERATE = store_thm (* from util_prob *) 6100 ("ENUMERATE", 6101 ``!s. (?f :num -> 'a. BIJ f UNIV s) = BIJ (enumerate s) UNIV s``, 6102 RW_TAC std_ss [boolTheory.EXISTS_DEF, enumerate_def]); 6103 6104Theorem COUNTABLE_ALT_BIJ: 6105 !s. countable s <=> FINITE s \/ BIJ (enumerate s) UNIV s 6106Proof 6107 rpt STRIP_TAC 6108 >> REVERSE EQ_TAC >- PROVE_TAC [finite_countable, BIJ_NUM_COUNTABLE] 6109 >> RW_TAC std_ss [COUNTABLE_ALT] 6110 >> Cases_on `FINITE s` >- PROVE_TAC [] 6111 >> RW_TAC std_ss [GSYM ENUMERATE] 6112 >> MATCH_MP_TAC BIJ_INJ_SURJ 6113 >> REVERSE CONJ_TAC 6114 >- (Know `~(s = {})` >- PROVE_TAC [FINITE_EMPTY] 6115 >> RW_TAC std_ss [GSYM MEMBER_NOT_EMPTY] 6116 >> Q.EXISTS_TAC `\n. if f n IN s then f n else x` 6117 >> RW_TAC std_ss [SURJ_DEF, IN_UNIV] 6118 >> PROVE_TAC []) 6119 >> MP_TAC (Q.SPEC `s` INFINITE_EXPLICIT_ENUMERATE) 6120 >> RW_TAC std_ss [] 6121 >> PROVE_TAC [] 6122QED 6123 6124Theorem COUNTABLE_ENUM: 6125 !c. countable c <=> c = {} \/ ?f :num -> 'a. c = IMAGE f UNIV 6126Proof 6127 RW_TAC std_ss [] 6128 >> REVERSE EQ_TAC 6129 >- (NTAC 2 (RW_TAC std_ss [countable_EMPTY]) 6130 >> RW_TAC std_ss [COUNTABLE_ALT] 6131 >> Q.EXISTS_TAC `f` 6132 >> RW_TAC std_ss [IN_IMAGE, IN_UNIV] 6133 >> PROVE_TAC []) 6134 >> REVERSE (RW_TAC std_ss [COUNTABLE_ALT_BIJ]) 6135 >- (DISJ2_TAC 6136 >> Q.EXISTS_TAC `enumerate c` 6137 >> POP_ASSUM MP_TAC 6138 >> RW_TAC std_ss [IN_UNIV, IN_IMAGE, BIJ_DEF, SURJ_DEF, EXTENSION] 6139 >> PROVE_TAC []) 6140 >> POP_ASSUM MP_TAC 6141 >> Q.SPEC_TAC (`c`, `c`) 6142 >> HO_MATCH_MP_TAC FINITE_INDUCT 6143 >> RW_TAC std_ss [] 6144 >- (DISJ2_TAC 6145 >> Q.EXISTS_TAC `K e` 6146 >> RW_TAC std_ss [EXTENSION, IN_SING, IN_IMAGE, IN_UNIV, combinTheory.K_THM]) 6147 >> DISJ2_TAC 6148 >> Q.EXISTS_TAC `\n. num_CASE n e f` 6149 >> RW_TAC std_ss [IN_INSERT, IN_IMAGE, EXTENSION, IN_UNIV] 6150 >> EQ_TAC >| 6151 [RW_TAC std_ss [] >| 6152 [Q.EXISTS_TAC `0` 6153 >> RW_TAC std_ss [num_case_def], 6154 Q.EXISTS_TAC `SUC x'` 6155 >> RW_TAC std_ss [num_case_def]], 6156 RW_TAC std_ss [] >> 6157 METIS_TAC [num_case_def, TypeBase.nchotomy_of ``:num``]] 6158QED 6159 6160(* END countability theorems *) 6161 6162 6163(* Misc theorems added by Thomas Tuerk on 2009-03-24 *) 6164 6165val IMAGE_BIGUNION = store_thm ("IMAGE_BIGUNION", 6166 ``!f M. IMAGE f (BIGUNION M) = 6167 BIGUNION (IMAGE (IMAGE f) M)``, 6168 6169ONCE_REWRITE_TAC [EXTENSION] THEN 6170SIMP_TAC bool_ss [IN_BIGUNION, IN_IMAGE, 6171 GSYM LEFT_EXISTS_AND_THM, 6172 GSYM RIGHT_EXISTS_AND_THM] THEN 6173METIS_TAC[]); 6174 6175 6176val SUBSET_DIFF = store_thm ("SUBSET_DIFF", 6177 ``!s1 s2 s3. (s1 SUBSET (s2 DIFF s3)) <=> s1 SUBSET s2 /\ DISJOINT s1 s3``, 6178 SIMP_TAC bool_ss [SUBSET_DEF, IN_DIFF, DISJOINT_DEF, EXTENSION, IN_INTER, 6179 NOT_IN_EMPTY] 6180 >> METIS_TAC []); 6181 6182val INTER_SUBSET_EQN = store_thm ("INTER_SUBSET_EQN", 6183 ``((A INTER B = A) = (A SUBSET B)) /\ 6184 ((A INTER B = B) = (B SUBSET A))``, 6185 SIMP_TAC bool_ss [EXTENSION, IN_INTER, SUBSET_DEF] 6186 >> METIS_TAC []); 6187 6188Theorem PSUBSET_SING: 6189 !s x. x PSUBSET {s} <=> (x = EMPTY) 6190Proof 6191SIMP_TAC bool_ss [PSUBSET_DEF, SUBSET_DEF, EXTENSION, 6192 IN_SING, NOT_IN_EMPTY] THEN 6193METIS_TAC[] 6194QED 6195 6196 6197val INTER_UNION = store_thm ("INTER_UNION", 6198``((A UNION B) INTER A = A) /\ 6199 ((B UNION A) INTER A = A) /\ 6200 (A INTER (A UNION B) = A) /\ 6201 (A INTER (B UNION A) = A)``, 6202SIMP_TAC bool_ss [INTER_SUBSET_EQN, SUBSET_UNION]); 6203 6204 6205val UNION_DELETE = store_thm ("UNION_DELETE", 6206``!A B x. (A UNION B) DELETE x = 6207 ((A DELETE x) UNION (B DELETE x))``, 6208 6209SIMP_TAC bool_ss [EXTENSION, IN_UNION, IN_DELETE] THEN 6210REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN 6211ASM_SIMP_TAC bool_ss []) 6212 6213Theorem DELETE_SUBSET_INSERT: 6214 !s e s2. s DELETE e SUBSET s2 <=> s SUBSET e INSERT s2 6215Proof REWRITE_TAC [GSYM SUBSET_INSERT_DELETE] 6216QED 6217 6218val IN_INSERT_EXPAND = store_thm ("IN_INSERT_EXPAND", 6219 ``!x y P. x IN y INSERT P <=> (x = y) \/ x <> y /\ x IN P``, 6220 SIMP_TAC bool_ss [IN_INSERT] THEN 6221 METIS_TAC[]); 6222 6223val FINITE_INTER = store_thm ("FINITE_INTER", 6224 ``!s1 s2. ((FINITE s1) \/ (FINITE s2)) ==> FINITE (s1 INTER s2)``, 6225 METIS_TAC[INTER_COMM, INTER_FINITE]); 6226(* END misc thms *) 6227 6228(*---------------------------------------------------------------------------*) 6229(* Various lemmas from the CakeML project https://cakeml.org *) 6230(*---------------------------------------------------------------------------*) 6231 6232val INSERT_EQ_SING = store_thm("INSERT_EQ_SING", 6233 ``!s x y. (x INSERT s = {y}) <=> ((x = y) /\ s SUBSET {y})``, 6234 SRW_TAC [] [SUBSET_DEF,EXTENSION] THEN METIS_TAC []); 6235 6236val CARD_UNION_LE = store_thm("CARD_UNION_LE", 6237 ``FINITE s /\ FINITE t ==> CARD (s UNION t) <= CARD s + CARD t``, 6238 SRW_TAC [][] THEN IMP_RES_TAC CARD_UNION THEN FULL_SIMP_TAC (srw_ss()++ARITH_ss) []) 6239 6240val IMAGE_SUBSET_gen = store_thm("IMAGE_SUBSET_gen", 6241 ``!f s u t. s SUBSET u /\ (IMAGE f u SUBSET t) ==> IMAGE f s SUBSET t``, 6242 SIMP_TAC (srw_ss())[SUBSET_DEF] THEN METIS_TAC[]) 6243 6244val CARD_REST = store_thm("CARD_REST", 6245 ``!s. FINITE s /\ s <> {} ==> (CARD (REST s) = CARD s - 1)``, 6246 SRW_TAC[][] THEN 6247 IMP_RES_TAC CHOICE_INSERT_REST THEN 6248 POP_ASSUM (fn th => CONV_TAC (RAND_CONV (REWRITE_CONV [Once(SYM th)]))) THEN 6249 Q.SPEC_THEN`REST s`MP_TAC CARD_INSERT THEN SRW_TAC[][] THEN 6250 FULL_SIMP_TAC(srw_ss())[REST_DEF]) 6251 6252val SUBSET_DIFF_EMPTY = store_thm("SUBSET_DIFF_EMPTY", 6253 ``!s t. (s DIFF t = {}) = (s SUBSET t)``, 6254 SRW_TAC[][EXTENSION,SUBSET_DEF] THEN PROVE_TAC[]) 6255 6256val DIFF_INTER_SUBSET = store_thm("DIFF_INTER_SUBSET", 6257 ``!r s t. r SUBSET s ==> (r DIFF s INTER t = r DIFF t)``, 6258 SRW_TAC[][EXTENSION,SUBSET_DEF] THEN PROVE_TAC[]) 6259 6260val UNION_DIFF_2 = store_thm("UNION_DIFF_2", 6261 ``!s t. (s UNION (s DIFF t) = s)``, 6262 SRW_TAC[][EXTENSION] THEN PROVE_TAC[]) 6263 6264val count_add = store_thm("count_add", 6265 ``!n m. count (n + m) = count n UNION IMAGE ($+ n) (count m)``, 6266 SRW_TAC[ARITH_ss][EXTENSION,EQ_IMP_THM] THEN 6267 Cases_on `x < n` THEN SRW_TAC[ARITH_ss][] THEN 6268 Q.EXISTS_TAC `x - n` THEN 6269 SRW_TAC[ARITH_ss][]) 6270 6271val IMAGE_EQ_SING = store_thm("IMAGE_EQ_SING", 6272 ``(IMAGE f s = {z}) <=> (s <> {}) /\ !x. x IN s ==> (f x = z)``, 6273 EQ_TAC THEN 6274 SRW_TAC[DNF_ss][EXTENSION] THEN 6275 PROVE_TAC[]) 6276 6277val count_add1 = Q.store_thm ("count_add1", 6278`!n. count (n + 1) = n INSERT count n`, 6279METIS_TAC [COUNT_SUC, arithmeticTheory.ADD1]); 6280 6281val compl_insert = Q.store_thm ("compl_insert", 6282`!s x. COMPL (x INSERT s) = COMPL s DELETE x`, 6283 SRW_TAC [] [EXTENSION, IN_COMPL] THEN 6284 METIS_TAC []); 6285 6286val in_max_set = Q.store_thm ("in_max_set", 6287`!s. FINITE s ==> !x. x IN s ==> x <= MAX_SET s`, 6288 HO_MATCH_MP_TAC FINITE_INDUCT THEN 6289 SRW_TAC [] [MAX_SET_THM] THEN 6290 SRW_TAC [] []); 6291 6292(* end CakeML lemmas *) 6293 6294(*---------------------------------------------------------------------------*) 6295(* PREIMAGE lemmas from util_probTheory *) 6296(*---------------------------------------------------------------------------*) 6297 6298val PREIMAGE_def = new_definition ( 6299 "PREIMAGE_def", ``PREIMAGE f s = {x | f x IN s}``); 6300 6301Theorem PREIMAGE_ALT: 6302 !f s. PREIMAGE f s = s o f 6303Proof 6304 Know `!x f s. x IN (s o f) <=> f x IN s` 6305 >- RW_TAC std_ss [SPECIFICATION, combinTheory.o_THM] 6306 >> RW_TAC std_ss [PREIMAGE_def, EXTENSION, GSPECIFICATION] 6307QED 6308 6309Theorem IN_PREIMAGE[simp]: 6310 !f s x. x IN PREIMAGE f s <=> f x IN s 6311Proof 6312 RW_TAC std_ss [PREIMAGE_def, GSPECIFICATION] 6313QED 6314 6315Theorem PREIMAGE_EMPTY[simp]: 6316 !f. PREIMAGE f {} = {} 6317Proof RW_TAC std_ss [EXTENSION, IN_PREIMAGE, NOT_IN_EMPTY] 6318QED 6319 6320Theorem PREIMAGE_UNIV[simp]: 6321 !f. PREIMAGE f UNIV = UNIV 6322Proof RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_UNIV] 6323QED 6324 6325val PREIMAGE_COMPL = store_thm 6326 ("PREIMAGE_COMPL", 6327 ``!f s. PREIMAGE f (COMPL s) = COMPL (PREIMAGE f s)``, 6328 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_COMPL]); 6329 6330val PREIMAGE_UNION = store_thm 6331 ("PREIMAGE_UNION", 6332 ``!f s t. PREIMAGE f (s UNION t) = PREIMAGE f s UNION PREIMAGE f t``, 6333 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_UNION]); 6334 6335val PREIMAGE_INTER = store_thm 6336 ("PREIMAGE_INTER", 6337 ``!f s t. PREIMAGE f (s INTER t) = PREIMAGE f s INTER PREIMAGE f t``, 6338 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_INTER]); 6339 6340val PREIMAGE_BIGUNION = store_thm 6341 ("PREIMAGE_BIGUNION", 6342 ``!f s. PREIMAGE f (BIGUNION s) = BIGUNION (IMAGE (PREIMAGE f) s)``, 6343 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_BIGUNION_IMAGE] 6344 >> RW_TAC std_ss [IN_BIGUNION] 6345 >> PROVE_TAC []); 6346 6347val PREIMAGE_COMP = store_thm 6348 ("PREIMAGE_COMP", 6349 ``!f g s. PREIMAGE f (PREIMAGE g s) = PREIMAGE (g o f) s``, 6350 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, o_THM]); 6351 6352val PREIMAGE_DIFF = store_thm 6353 ("PREIMAGE_DIFF", 6354 ``!f s t. PREIMAGE f (s DIFF t) = PREIMAGE f s DIFF PREIMAGE f t``, 6355 RW_TAC std_ss [Once EXTENSION, IN_PREIMAGE, IN_DIFF]); 6356 6357val PREIMAGE_I = store_thm 6358 ("PREIMAGE_I", 6359 ``PREIMAGE I = I``, 6360 METIS_TAC [EXTENSION, IN_PREIMAGE, combinTheory.I_THM]); 6361 6362val PREIMAGE_K = store_thm 6363 ("PREIMAGE_K", 6364 ``!x s. PREIMAGE (K x) s = if x IN s then UNIV else {}``, 6365 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, combinTheory.K_THM, IN_UNIV, NOT_IN_EMPTY]); 6366 6367val PREIMAGE_DISJOINT = store_thm 6368 ("PREIMAGE_DISJOINT", 6369 ``!f s t. DISJOINT s t ==> DISJOINT (PREIMAGE f s) (PREIMAGE f t)``, 6370 RW_TAC std_ss [DISJOINT_DEF, GSYM PREIMAGE_INTER, PREIMAGE_EMPTY]); 6371 6372val PREIMAGE_SUBSET = store_thm 6373 ("PREIMAGE_SUBSET", 6374 ``!f s t. s SUBSET t ==> PREIMAGE f s SUBSET PREIMAGE f t``, 6375 RW_TAC std_ss [SUBSET_DEF, PREIMAGE_def, GSPECIFICATION]); 6376 6377val PREIMAGE_CROSS = store_thm 6378 ("PREIMAGE_CROSS", 6379 ``!f a b. 6380 PREIMAGE f (a CROSS b) = 6381 PREIMAGE (FST o f) a INTER PREIMAGE (SND o f) b``, 6382 RW_TAC std_ss [EXTENSION, IN_PREIMAGE, IN_CROSS, IN_INTER, o_THM]); 6383 6384val PREIMAGE_COMPL_INTER = store_thm 6385 ("PREIMAGE_COMPL_INTER", ``!f t sp. PREIMAGE f (COMPL t) INTER sp = sp DIFF (PREIMAGE f t)``, 6386 RW_TAC std_ss [COMPL_DEF] 6387 >> MP_TAC (REWRITE_RULE [PREIMAGE_UNIV] (Q.SPECL [`f`,`UNIV`,`t`] PREIMAGE_DIFF)) 6388 >> STRIP_TAC 6389 >> `(PREIMAGE f (UNIV DIFF t)) INTER sp = (UNIV DIFF PREIMAGE f t) INTER sp` by METIS_TAC [] 6390 >> METIS_TAC [DIFF_INTER,INTER_UNIV]); 6391 6392val PREIMAGE_IMAGE = store_thm (* from miller *) 6393 ("PREIMAGE_IMAGE", 6394 ``!f s. s SUBSET PREIMAGE f (IMAGE f s)``, 6395 RW_TAC std_ss [SUBSET_DEF, IN_PREIMAGE, IN_IMAGE] 6396 >> PROVE_TAC []); 6397 6398val IMAGE_PREIMAGE = store_thm (* from miller *) 6399 ("IMAGE_PREIMAGE", 6400 ``!f s. IMAGE f (PREIMAGE f s) SUBSET s``, 6401 RW_TAC std_ss [SUBSET_DEF, IN_PREIMAGE, IN_IMAGE] 6402 >> PROVE_TAC []); 6403 6404Theorem FINITE_PREIMAGE: 6405 (!x y. f x = f y <=> x = y) /\ FINITE s ==> FINITE (PREIMAGE f s) 6406Proof 6407 Induct_on ���FINITE��� >> simp[PREIMAGE_EMPTY] >> rw[] >> fs[] >> 6408 simp[Once INSERT_SING_UNION, PREIMAGE_UNION] >> 6409 simp[PREIMAGE_def] >> 6410 Cases_on ���?x. f x = e��� >> fs[] >> 6411 ���!y. f y = e <=> y = x��� by METIS_TAC[] >> simp[] 6412QED 6413 6414(* end PREIMAGE lemmas *) 6415 6416(* "<<=" is overloaded in listTheory, cardinalTheory and maybe others, 6417 we put its Unicode and TeX definitions here to make sure by loading any of the 6418 theories user could see the Unicode representations. *) 6419 6420val _ = set_fixity "<<=" (Infix(NONASSOC, 450)); 6421 6422val _ = Unicode.unicode_version {u = UTF8.chr 0x227C, tmnm = "<<="}; 6423 (* in tex input mode in emacs, produce U+227C with \preceq *) 6424 (* tempting to add a not-isprefix macro keyed to U+22E0 \npreceq, but 6425 hard to know what the ASCII version should be. *) 6426 6427val _ = TeX_notation {hol = "<<=", TeX = ("\\HOLTokenIsPrefix{}", 1)}; 6428val _ = TeX_notation {hol = UTF8.chr 0x227C, TeX = ("\\HOLTokenIsPrefix{}", 1)}; 6429 6430val is_measure_maximal_def = new_definition("is_measure_maximal_def", 6431 ���is_measure_maximal m s x <=> x IN s /\ !y. y IN s ==> m y <= m x��� 6432); 6433 6434val FINITE_is_measure_maximal = Q.store_thm( 6435 "FINITE_is_measure_maximal", 6436 ���!s. FINITE s /\ s <> {} ==> ?x. is_measure_maximal m s x���, 6437 ���!s. FINITE s ==> s <> {} ==> ?x. is_measure_maximal m s x��� 6438 suffices_by METIS_TAC[] >> 6439 Induct_on ���FINITE��� >> simp[] >> rpt strip_tac >> Cases_on ���s = {}��� >> simp[] 6440 >- (Q.RENAME_TAC [���{e}���] >> Q.EXISTS_TAC ���e��� >> 6441 simp[is_measure_maximal_def]) >> 6442 fs[is_measure_maximal_def] >> Q.RENAME_TAC [���m _ <= m e0���, ���e NOTIN s���] >> 6443 Cases_on ���m e0 <= m e��� 6444 >- (Q.EXISTS_TAC ���e��� >> SRW_TAC[][] >> simp[] >> 6445 METIS_TAC[arithmeticTheory.LESS_EQ_TRANS]) >> 6446 Q.EXISTS_TAC ���e0��� >> simp[DISJ_IMP_THM]); 6447 6448val is_measure_maximal_SING = Q.store_thm( 6449 "is_measure_maximal_SING[simp]", 6450 ���is_measure_maximal m {x} y <=> (y = x)���, 6451 simp[is_measure_maximal_def, EQ_IMP_THM]); 6452 6453val is_measure_maximal_INSERT = Q.store_thm( 6454 "is_measure_maximal_INSERT", 6455 ���!x s m e y. 6456 x IN s /\ m e < m x ==> 6457 (is_measure_maximal m (e INSERT s) y <=> is_measure_maximal m s y)���, 6458 simp[is_measure_maximal_def] >> rpt strip_tac >> eq_tac >> SRW_TAC[][] 6459 >- METIS_TAC[DECIDE ���(x <= y /\ y < z ==> x < z) /\ ~(a < a)���] 6460 >- METIS_TAC[DECIDE ���x < y /\ y <= z ==> x <= z���] 6461 >- METIS_TAC[]); 6462 6463val _ = export_rewrites 6464 [ 6465 (* BIGUNION/BIGINTER theorems *) 6466 "DISJOINT_BIGUNION", 6467 "BIGUNION_UNION", "BIGINTER_UNION", 6468 "DISJOINT_BIGUNION", 6469 (* cardinality theorems *) 6470 "CARD_DIFF", "CARD_EQ_0", 6471 "CARD_INTER_LESS_EQ", "CARD_DELETE", "CARD_DIFF", 6472 (* complement theorems *) 6473 "COMPL_CLAUSES", "COMPL_COMPL", "COMPL_EMPTY", 6474 (* "DELETE" theorems *) 6475 "DELETE_DELETE", "DELETE_EQ_SING", "DELETE_SUBSET", 6476 (* "DIFF" theorems *) 6477 "DIFF_DIFF", "DIFF_EMPTY", "DIFF_EQ_EMPTY", "DIFF_UNIV", 6478 "DIFF_SUBSET", 6479 (* "DISJOINT" theorems *) 6480 "DISJOINT_EMPTY", "DISJOINT_UNION_BOTH", 6481 "DISJOINT_EMPTY_REFL_RWT", 6482 (* "IMAGE" theorems *) 6483 "IMAGE_DELETE", "IMAGE_FINITE", "IMAGE_ID", "IMAGE_IN", 6484 "IMAGE_SUBSET", "IMAGE_UNION", 6485 (* "INSERT" theorems *) 6486 "INSERT_DELETE", "INSERT_DIFF", "INSERT_INSERT", "INSERT_SUBSET", 6487 (* "INTER" theorems *) 6488 "INTER_FINITE", "INTER_IDEMPOT", 6489 "INTER_SUBSET", "INTER_UNIV", "SUBSET_INTER", 6490 (* "REST" *) 6491 "REST_PSUBSET", "REST_SUBSET", "FINITE_REST", 6492 (* "SUBSET" *) 6493 "SUBSET_INSERT", 6494 (* "UNION" *) 6495 "UNION_IDEMPOT", "UNION_SUBSET", 6496 "SUBSET_UNION" 6497]; 6498 6499val _ = Theory.quote_adjoin_to_theory 6500 `val SET_SPEC_ss : simpLib.ssfrag` 6501`local 6502 val GSPEC_t = prim_mk_const {Name = "GSPEC", Thy = "pred_set"} 6503 val IN_t = mk_thy_const {Name = "IN", Thy = "bool", 6504 Ty = alpha --> (alpha --> bool) --> bool} 6505 val f_t = mk_var ("f", beta --> pairSyntax.mk_prod (alpha, bool)) 6506 val x_t = mk_var ("x", alpha) 6507 val SET_SPEC_CONV = 6508 {conv = Lib.K (Lib.K (PGspec.SET_SPEC_CONV GSPECIFICATION)), 6509 key = SOME ([], list_mk_comb (IN_t, [x_t, mk_comb (GSPEC_t, f_t)])), 6510 name = "SET_SPEC_CONV", 6511 trace = 2} 6512in 6513 val SET_SPEC_ss = 6514 simpLib.SSFRAG 6515 {name = SOME "SET_SPEC", ac = [], congs = [], convs = [SET_SPEC_CONV], 6516 dprocs = [], filter = NONE, rewrs = []} 6517 val _ = BasicProvers.logged_addfrags {thyname = "pred_set"} [SET_SPEC_ss] 6518end 6519` 6520 6521val _ = export_theory(); 6522 6523end (* struct *) 6524