src/HOL/Predicate.thy
author urbanc
Tue Jun 05 09:56:19 2007 +0200 (2007-06-05)
changeset 23243 a37d3e6e8323
parent 22846 fb79144af9a3
child 23389 aaca6a8e5414
permissions -rw-r--r--
included Class.thy in the compiling process for Nominal/Examples
     1 (*  Title:      HOL/Predicate.thy
     2     ID:         $Id$
     3     Author:     Stefan Berghofer, TU Muenchen
     4 *)
     5 
     6 header {* Predicates *}
     7 
     8 theory Predicate
     9 imports Inductive
    10 begin
    11 
    12 subsection {* Converting between predicates and sets *}
    13 
    14 definition
    15   member :: "'a set => 'a => bool" where
    16   "member == %S x. x : S"
    17 
    18 lemma memberI[intro!, Pure.intro!]: "x : S ==> member S x"
    19   by (simp add: member_def)
    20 
    21 lemma memberD[dest!, Pure.dest!]: "member S x ==> x : S"
    22   by (simp add: member_def)
    23 
    24 lemma member_eq[simp]: "member S x = (x : S)"
    25   by (simp add: member_def)
    26 
    27 lemma member_Collect_eq[simp]: "member (Collect P) = P"
    28   by (simp add: member_def)
    29 
    30 lemma Collect_member_eq[simp]: "Collect (member S) = S"
    31   by (simp add: member_def)
    32 
    33 lemma split_set: "(!!S. PROP P S) == (!!S. PROP P (Collect S))"
    34 proof
    35   fix S
    36   assume "!!S. PROP P S"
    37   show "PROP P (Collect S)" .
    38 next
    39   fix S
    40   assume "!!S. PROP P (Collect S)"
    41   have "PROP P {x. x : S}" .
    42   thus "PROP P S" by simp
    43 qed
    44 
    45 lemma split_predicate: "(!!S. PROP P S) == (!!S. PROP P (member S))"
    46 proof
    47   fix S
    48   assume "!!S. PROP P S"
    49   show "PROP P (member S)" .
    50 next
    51   fix S
    52   assume "!!S. PROP P (member S)"
    53   have "PROP P (member {x. S x})" .
    54   thus "PROP P S" by simp
    55 qed
    56 
    57 lemma member_right_eq: "(x == member y) == (Collect x == y)"
    58   by (rule equal_intr_rule, simp, drule symmetric, simp)
    59 
    60 definition
    61   member2 :: "('a * 'b) set => 'a => 'b \<Rightarrow> bool" where
    62   "member2 == %S x y. (x, y) : S"
    63 
    64 definition
    65   Collect2 :: "('a => 'b => bool) => ('a * 'b) set" where
    66   "Collect2 == %P. {(x, y). P x y}"
    67 
    68 lemma member2I[intro!, Pure.intro!]: "(x, y) : S ==> member2 S x y"
    69   by (simp add: member2_def)
    70 
    71 lemma member2D[dest!, Pure.dest!]: "member2 S x y ==> (x, y) : S"
    72   by (simp add: member2_def)
    73 
    74 lemma member2_eq[simp]: "member2 S x y = ((x, y) : S)"
    75   by (simp add: member2_def)
    76 
    77 lemma Collect2I: "P x y ==> (x, y) : Collect2 P"
    78   by (simp add: Collect2_def)
    79 
    80 lemma Collect2D: "(x, y) : Collect2 P ==> P x y"
    81   by (simp add: Collect2_def)
    82 
    83 lemma member2_Collect2_eq[simp]: "member2 (Collect2 P) = P"
    84   by (simp add: member2_def Collect2_def)
    85 
    86 lemma Collect2_member2_eq[simp]: "Collect2 (member2 S) = S"
    87   by (auto simp add: member2_def Collect2_def)
    88 
    89 lemma mem_Collect2_eq[iff]: "((x, y) : Collect2 P) = P x y"
    90   by (iprover intro: Collect2I dest: Collect2D)
    91 
    92 lemma member2_Collect_split_eq [simp]: "member2 (Collect (split P)) = P"
    93   by (simp add: expand_fun_eq)
    94 
    95 lemma split_set2: "(!!S. PROP P S) == (!!S. PROP P (Collect2 S))"
    96 proof
    97   fix S
    98   assume "!!S. PROP P S"
    99   show "PROP P (Collect2 S)" .
   100 next
   101   fix S
   102   assume "!!S. PROP P (Collect2 S)"
   103   have "PROP P (Collect2 (member2 S))" .
   104   thus "PROP P S" by simp
   105 qed
   106 
   107 lemma split_predicate2: "(!!S. PROP P S) == (!!S. PROP P (member2 S))"
   108 proof
   109   fix S
   110   assume "!!S. PROP P S"
   111   show "PROP P (member2 S)" .
   112 next
   113   fix S
   114   assume "!!S. PROP P (member2 S)"
   115   have "PROP P (member2 (Collect2 S))" .
   116   thus "PROP P S" by simp
   117 qed
   118 
   119 lemma member2_right_eq: "(x == member2 y) == (Collect2 x == y)"
   120   by (rule equal_intr_rule, simp, drule symmetric, simp)
   121 
   122 ML_setup {*
   123 local
   124 
   125 fun vars_of b (v as Var _) = if b then [] else [v]
   126   | vars_of b (t $ u) = vars_of true t union vars_of false u
   127   | vars_of b (Abs (_, _, t)) = vars_of false t
   128   | vars_of _ _ = [];
   129 
   130 fun rew ths1 ths2 th = Drule.forall_elim_vars 0
   131   (rewrite_rule ths2 (rewrite_rule ths1 (Drule.forall_intr_list
   132     (map (cterm_of (theory_of_thm th)) (vars_of false (prop_of th))) th)));
   133 
   134 val get_eq = Simpdata.mk_eq o thm;
   135 
   136 val split_predicate = get_eq "split_predicate";
   137 val split_predicate2 = get_eq "split_predicate2";
   138 val split_set = get_eq "split_set";
   139 val split_set2 = get_eq "split_set2";
   140 val member_eq = get_eq "member_eq";
   141 val member2_eq = get_eq "member2_eq";
   142 val member_Collect_eq = get_eq "member_Collect_eq";
   143 val member2_Collect2_eq = get_eq "member2_Collect2_eq";
   144 val mem_Collect2_eq = get_eq "mem_Collect2_eq";
   145 val member_right_eq = thm "member_right_eq";
   146 val member2_right_eq = thm "member2_right_eq";
   147 
   148 val rew' = Thm.symmetric o rew [split_set2] [split_set,
   149   member_right_eq, member2_right_eq, member_Collect_eq, member2_Collect2_eq];
   150 
   151 val rules1 = [split_predicate, split_predicate2, member_eq, member2_eq];
   152 val rules2 = [split_set, mk_meta_eq mem_Collect_eq, mem_Collect2_eq];
   153 
   154 structure PredSetConvData = GenericDataFun
   155 (
   156   type T = thm list;
   157   val empty = [];
   158   val extend = I;
   159   fun merge _ = Drule.merge_rules;
   160 );
   161 
   162 fun mk_attr ths1 ths2 f = Attrib.syntax (Attrib.thms >> (fn ths =>
   163   Thm.rule_attribute (fn ctxt => rew ths1 (map (f o Simpdata.mk_eq)
   164     (ths @ PredSetConvData.get ctxt) @ ths2))));
   165 
   166 val pred_set_conv_att = Attrib.no_args (Thm.declaration_attribute
   167   (Drule.add_rule #> PredSetConvData.map));
   168 
   169 in
   170 
   171 val _ = ML_Context.>> (
   172   Attrib.add_attributes
   173     [("pred_set_conv", pred_set_conv_att,
   174         "declare rules for converting between predicate and set notation"),
   175      ("to_set", mk_attr [] rules1 I, "convert rule to set notation"),
   176      ("to_pred", mk_attr [split_set2] rules2 rew',
   177         "convert rule to predicate notation")])
   178 
   179 end;
   180 *}
   181 
   182 lemma member_inject [pred_set_conv]: "(member R = member S) = (R = S)"
   183   by (auto simp add: expand_fun_eq)
   184 
   185 lemma member2_inject [pred_set_conv]: "(member2 R = member2 S) = (R = S)"
   186   by (auto simp add: expand_fun_eq)
   187 
   188 lemma member_mono [pred_set_conv]: "(member R <= member S) = (R <= S)"
   189   by fast
   190 
   191 lemma member2_mono [pred_set_conv]: "(member2 R <= member2 S) = (R <= S)"
   192   by fast
   193 
   194 lemma member_empty [pred_set_conv]: "(%x. False) = member {}"
   195   by (simp add: expand_fun_eq)
   196 
   197 lemma member2_empty [pred_set_conv]: "(%x y. False) = member2 {}"
   198   by (simp add: expand_fun_eq)
   199 
   200 
   201 subsubsection {* Binary union *}
   202 
   203 lemma member_Un [pred_set_conv]: "sup (member R) (member S) = member (R Un S)"
   204   by (simp add: expand_fun_eq sup_fun_eq sup_bool_eq)
   205 
   206 lemma member2_Un [pred_set_conv]: "sup (member2 R) (member2 S) = member2 (R Un S)"
   207   by (simp add: expand_fun_eq sup_fun_eq sup_bool_eq)
   208 
   209 lemma sup1_iff [simp]: "sup A B x \<longleftrightarrow> A x | B x"
   210   by (simp add: sup_fun_eq sup_bool_eq)
   211 
   212 lemma sup2_iff [simp]: "sup A B x y \<longleftrightarrow> A x y | B x y"
   213   by (simp add: sup_fun_eq sup_bool_eq)
   214 
   215 lemma sup1I1 [elim?]: "A x \<Longrightarrow> sup A B x"
   216   by simp
   217 
   218 lemma sup2I1 [elim?]: "A x y \<Longrightarrow> sup A B x y"
   219   by simp
   220 
   221 lemma join1I2 [elim?]: "B x \<Longrightarrow> sup A B x"
   222   by simp
   223 
   224 lemma sup1I2 [elim?]: "B x y \<Longrightarrow> sup A B x y"
   225   by simp
   226 
   227 text {*
   228   \medskip Classical introduction rule: no commitment to @{text A} vs
   229   @{text B}.
   230 *}
   231 
   232 lemma sup1CI [intro!]: "(~ B x ==> A x) ==> sup A B x"
   233   by auto
   234 
   235 lemma sup2CI [intro!]: "(~ B x y ==> A x y) ==> sup A B x y"
   236   by auto
   237 
   238 lemma sup1E [elim!]: "sup A B x ==> (A x ==> P) ==> (B x ==> P) ==> P"
   239   by simp iprover
   240 
   241 lemma sup2E [elim!]: "sup A B x y ==> (A x y ==> P) ==> (B x y ==> P) ==> P"
   242   by simp iprover
   243 
   244 
   245 subsubsection {* Binary intersection *}
   246 
   247 lemma member_Int [pred_set_conv]: "inf (member R) (member S) = member (R Int S)"
   248   by (simp add: expand_fun_eq inf_fun_eq inf_bool_eq)
   249 
   250 lemma member2_Int [pred_set_conv]: "inf (member2 R) (member2 S) = member2 (R Int S)"
   251   by (simp add: expand_fun_eq inf_fun_eq inf_bool_eq)
   252 
   253 lemma inf1_iff [simp]: "inf A B x \<longleftrightarrow> A x \<and> B x"
   254   by (simp add: inf_fun_eq inf_bool_eq)
   255 
   256 lemma inf2_iff [simp]: "inf A B x y \<longleftrightarrow> A x y \<and> B x y"
   257   by (simp add: inf_fun_eq inf_bool_eq)
   258 
   259 lemma inf1I [intro!]: "A x ==> B x ==> inf A B x"
   260   by simp
   261 
   262 lemma inf2I [intro!]: "A x y ==> B x y ==> inf A B x y"
   263   by simp
   264 
   265 lemma inf1D1: "inf A B x ==> A x"
   266   by simp
   267 
   268 lemma inf2D1: "inf A B x y ==> A x y"
   269   by simp
   270 
   271 lemma inf1D2: "inf A B x ==> B x"
   272   by simp
   273 
   274 lemma inf2D2: "inf A B x y ==> B x y"
   275   by simp
   276 
   277 lemma inf1E [elim!]: "inf A B x ==> (A x ==> B x ==> P) ==> P"
   278   by simp
   279 
   280 lemma inf2E [elim!]: "inf A B x y ==> (A x y ==> B x y ==> P) ==> P"
   281   by simp
   282 
   283 
   284 subsubsection {* Unions of families *}
   285 
   286 lemma member_SUP: "(SUP i. member (r i)) = member (UN i. r i)"
   287   by (simp add: SUPR_def Sup_fun_eq Sup_bool_eq expand_fun_eq) blast
   288 
   289 lemma member2_SUP: "(SUP i. member2 (r i)) = member2 (UN i. r i)"
   290   by (simp add: SUPR_def Sup_fun_eq Sup_bool_eq expand_fun_eq) blast
   291 
   292 lemma SUP1_iff [simp]: "(SUP x:A. B x) b = (EX x:A. B x b)"
   293   by (simp add: SUPR_def Sup_fun_eq Sup_bool_eq) blast
   294 
   295 lemma SUP2_iff [simp]: "(SUP x:A. B x) b c = (EX x:A. B x b c)"
   296   by (simp add: SUPR_def Sup_fun_eq Sup_bool_eq) blast
   297 
   298 lemma SUP1_I [intro]: "a : A ==> B a b ==> (SUP x:A. B x) b"
   299   by auto
   300 
   301 lemma SUP2_I [intro]: "a : A ==> B a b c ==> (SUP x:A. B x) b c"
   302   by auto
   303 
   304 lemma SUP1_E [elim!]: "(SUP x:A. B x) b ==> (!!x. x : A ==> B x b ==> R) ==> R"
   305   by auto
   306 
   307 lemma SUP2_E [elim!]: "(SUP x:A. B x) b c ==> (!!x. x : A ==> B x b c ==> R) ==> R"
   308   by auto
   309 
   310 
   311 subsubsection {* Intersections of families *}
   312 
   313 lemma member_INF: "(INF i. member (r i)) = member (INT i. r i)"
   314   by (simp add: INFI_def Inf_fun_def Inf_bool_def expand_fun_eq) blast
   315 
   316 lemma member2_INF: "(INF i. member2 (r i)) = member2 (INT i. r i)"
   317   by (simp add: INFI_def Inf_fun_def Inf_bool_def expand_fun_eq) blast
   318 
   319 lemma INF1_iff [simp]: "(INF x:A. B x) b = (ALL x:A. B x b)"
   320   by (simp add: INFI_def Inf_fun_def Inf_bool_def) blast
   321 
   322 lemma INF2_iff [simp]: "(INF x:A. B x) b c = (ALL x:A. B x b c)"
   323   by (simp add: INFI_def Inf_fun_def Inf_bool_def) blast
   324 
   325 lemma INF1_I [intro!]: "(!!x. x : A ==> B x b) ==> (INF x:A. B x) b"
   326   by auto
   327 
   328 lemma INF2_I [intro!]: "(!!x. x : A ==> B x b c) ==> (INF x:A. B x) b c"
   329   by auto
   330 
   331 lemma INF1_D [elim]: "(INF x:A. B x) b ==> a : A ==> B a b"
   332   by auto
   333 
   334 lemma INF2_D [elim]: "(INF x:A. B x) b c ==> a : A ==> B a b c"
   335   by auto
   336 
   337 lemma INF1_E [elim]: "(INF x:A. B x) b ==> (B a b ==> R) ==> (a ~: A ==> R) ==> R"
   338   by auto
   339 
   340 lemma INF2_E [elim]: "(INF x:A. B x) b c ==> (B a b c ==> R) ==> (a ~: A ==> R) ==> R"
   341   by auto
   342 
   343 
   344 subsection {* Composition of two relations *}
   345 
   346 inductive2
   347   pred_comp  :: "['b => 'c => bool, 'a => 'b => bool] => 'a => 'c => bool"
   348     (infixr "OO" 75)
   349   for r :: "'b => 'c => bool" and s :: "'a => 'b => bool"
   350 where
   351   pred_compI [intro]: "s a b ==> r b c ==> (r OO s) a c"
   352 
   353 inductive_cases2 pred_compE [elim!]: "(r OO s) a c"
   354 
   355 lemma pred_comp_rel_comp_eq [pred_set_conv]:
   356   "(member2 r OO member2 s) = member2 (r O s)"
   357   by (auto simp add: expand_fun_eq elim: pred_compE)
   358 
   359 
   360 subsection {* Converse *}
   361 
   362 inductive2
   363   conversep :: "('a => 'b => bool) => 'b => 'a => bool"
   364     ("(_^--1)" [1000] 1000)
   365   for r :: "'a => 'b => bool"
   366 where
   367   conversepI: "r a b ==> r^--1 b a"
   368 
   369 notation (xsymbols)
   370   conversep  ("(_\<inverse>\<inverse>)" [1000] 1000)
   371 
   372 lemma conversepD:
   373   assumes ab: "r^--1 a b"
   374   shows "r b a" using ab
   375   by cases simp
   376 
   377 lemma conversep_iff [iff]: "r^--1 a b = r b a"
   378   by (iprover intro: conversepI dest: conversepD)
   379 
   380 lemma conversep_converse_eq [pred_set_conv]:
   381   "(member2 r)^--1 = member2 (r^-1)"
   382   by (auto simp add: expand_fun_eq)
   383 
   384 lemma conversep_conversep [simp]: "(r^--1)^--1 = r"
   385   by (iprover intro: order_antisym conversepI dest: conversepD)
   386 
   387 lemma converse_pred_comp: "(r OO s)^--1 = s^--1 OO r^--1"
   388   by (iprover intro: order_antisym conversepI pred_compI
   389     elim: pred_compE dest: conversepD)
   390 
   391 lemma converse_meet: "(inf r s)^--1 = inf r^--1 s^--1"
   392   by (simp add: inf_fun_eq inf_bool_eq)
   393     (iprover intro: conversepI ext dest: conversepD)
   394 
   395 lemma converse_join: "(sup r s)^--1 = sup r^--1 s^--1"
   396   by (simp add: sup_fun_eq sup_bool_eq)
   397     (iprover intro: conversepI ext dest: conversepD)
   398 
   399 lemma conversep_noteq [simp]: "(op ~=)^--1 = op ~="
   400   by (auto simp add: expand_fun_eq)
   401 
   402 lemma conversep_eq [simp]: "(op =)^--1 = op ="
   403   by (auto simp add: expand_fun_eq)
   404 
   405 
   406 subsection {* Domain *}
   407 
   408 inductive2
   409   DomainP :: "('a => 'b => bool) => 'a => bool"
   410   for r :: "'a => 'b => bool"
   411 where
   412   DomainPI [intro]: "r a b ==> DomainP r a"
   413 
   414 inductive_cases2 DomainPE [elim!]: "DomainP r a"
   415 
   416 lemma member2_DomainP [pred_set_conv]: "DomainP (member2 r) = member (Domain r)"
   417   by (blast intro!: Orderings.order_antisym)
   418 
   419 
   420 subsection {* Range *}
   421 
   422 inductive2
   423   RangeP :: "('a => 'b => bool) => 'b => bool"
   424   for r :: "'a => 'b => bool"
   425 where
   426   RangePI [intro]: "r a b ==> RangeP r b"
   427 
   428 inductive_cases2 RangePE [elim!]: "RangeP r b"
   429 
   430 lemma member2_RangeP [pred_set_conv]: "RangeP (member2 r) = member (Range r)"
   431   by (blast intro!: Orderings.order_antisym)
   432 
   433 
   434 subsection {* Inverse image *}
   435 
   436 definition
   437   inv_imagep :: "('b => 'b => bool) => ('a => 'b) => 'a => 'a => bool" where
   438   "inv_imagep r f == %x y. r (f x) (f y)"
   439 
   440 lemma [pred_set_conv]: "inv_imagep (member2 r) f = member2 (inv_image r f)"
   441   by (simp add: inv_image_def inv_imagep_def)
   442 
   443 lemma in_inv_imagep [simp]: "inv_imagep r f x y = r (f x) (f y)"
   444   by (simp add: inv_imagep_def)
   445 
   446 
   447 subsection {* Properties of relations - predicate versions *}
   448 
   449 abbreviation antisymP :: "('a => 'a => bool) => bool" where
   450   "antisymP r == antisym (Collect2 r)"
   451 
   452 abbreviation transP :: "('a => 'a => bool) => bool" where
   453   "transP r == trans (Collect2 r)"
   454 
   455 abbreviation single_valuedP :: "('a => 'b => bool) => bool" where
   456   "single_valuedP r == single_valued (Collect2 r)"
   457 
   458 
   459 subsection {* Bounded quantifiers for predicates *}
   460 
   461 text {*
   462 Bounded existential quantifier for predicates (executable).
   463 *}
   464 
   465 inductive2 bexp :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
   466   for P :: "'a \<Rightarrow> bool" and Q :: "'a \<Rightarrow> bool"
   467 where
   468   bexpI [intro]: "P x \<Longrightarrow> Q x \<Longrightarrow> bexp P Q"
   469 
   470 lemmas bexpE [elim!] = bexp.cases
   471 
   472 syntax
   473   Bexp :: "'a \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool \<Rightarrow> bool" ("(3\<exists>_\<triangleright>_./ _)" [0, 0, 10] 10)
   474 
   475 translations
   476   "\<exists>x\<triangleright>P. Q" \<rightleftharpoons> "CONST bexp P (\<lambda>x. Q)"
   477 
   478 constdefs
   479   ballp :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
   480   "ballp P Q \<equiv> \<forall>x. P x \<longrightarrow> Q x"
   481 
   482 syntax
   483   Ballp :: "'a \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool \<Rightarrow> bool" ("(3\<forall>_\<triangleright>_./ _)" [0, 0, 10] 10)
   484 
   485 translations
   486   "\<forall>x\<triangleright>P. Q" \<rightleftharpoons> "CONST ballp P (\<lambda>x. Q)"
   487 
   488 (* To avoid eta-contraction of body: *)
   489 print_translation {*
   490 let
   491   fun btr' syn [A,Abs abs] =
   492     let val (x,t) = atomic_abs_tr' abs
   493     in Syntax.const syn $ x $ A $ t end
   494 in
   495 [("ballp", btr' "Ballp"),("bexp", btr' "Bexp")]
   496 end
   497 *}
   498 
   499 lemma ballpI [intro!]: "(\<And>x. A x \<Longrightarrow> P x) \<Longrightarrow> \<forall>x\<triangleright>A. P x"
   500   by (simp add: ballp_def)
   501 
   502 lemma bspecp [dest?]: "\<forall>x\<triangleright>A. P x \<Longrightarrow> A x \<Longrightarrow> P x"
   503   by (simp add: ballp_def)
   504 
   505 lemma ballpE [elim]: "\<forall>x\<triangleright>A. P x \<Longrightarrow> (P x \<Longrightarrow> Q) \<Longrightarrow> (\<not> A x \<Longrightarrow> Q) \<Longrightarrow> Q"
   506   by (unfold ballp_def) blast
   507 
   508 lemma ballp_not_bexp_eq: "(\<forall>x\<triangleright>P. Q x) = (\<not> (\<exists>x\<triangleright>P. \<not> Q x))"
   509   by (blast dest: bspecp)
   510 
   511 declare ballp_not_bexp_eq [THEN eq_reflection, code unfold]
   512 
   513 end