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