src/ZF/Epsilon.thy
author krauss
Mon Feb 11 15:40:21 2008 +0100 (2008-02-11)
changeset 26056 6a0801279f4c
parent 24893 b8ef7afe3a6b
child 35762 af3ff2ba4c54
permissions -rw-r--r--
Made theory names in ZF disjoint from HOL theory names to allow loading both developments
in a single session (but not merge them).
     1 (*  Title:      ZF/epsilon.thy
     2     ID:         $Id$
     3     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     4     Copyright   1993  University of Cambridge
     5 
     6 *)
     7 
     8 header{*Epsilon Induction and Recursion*}
     9 
    10 theory Epsilon imports Nat_ZF begin
    11 
    12 definition
    13   eclose    :: "i=>i"  where
    14     "eclose(A) == \<Union>n\<in>nat. nat_rec(n, A, %m r. Union(r))"
    15 
    16 definition
    17   transrec  :: "[i, [i,i]=>i] =>i"  where
    18     "transrec(a,H) == wfrec(Memrel(eclose({a})), a, H)"
    19  
    20 definition
    21   rank      :: "i=>i"  where
    22     "rank(a) == transrec(a, %x f. \<Union>y\<in>x. succ(f`y))"
    23 
    24 definition
    25   transrec2 :: "[i, i, [i,i]=>i] =>i"  where
    26     "transrec2(k, a, b) ==                     
    27        transrec(k, 
    28                 %i r. if(i=0, a, 
    29                         if(EX j. i=succ(j),        
    30                            b(THE j. i=succ(j), r`(THE j. i=succ(j))),   
    31                            \<Union>j<i. r`j)))"
    32 
    33 definition
    34   recursor  :: "[i, [i,i]=>i, i]=>i"  where
    35     "recursor(a,b,k) ==  transrec(k, %n f. nat_case(a, %m. b(m, f`m), n))"
    36 
    37 definition
    38   rec  :: "[i, i, [i,i]=>i]=>i"  where
    39     "rec(k,a,b) == recursor(a,b,k)"
    40 
    41 
    42 subsection{*Basic Closure Properties*}
    43 
    44 lemma arg_subset_eclose: "A <= eclose(A)"
    45 apply (unfold eclose_def)
    46 apply (rule nat_rec_0 [THEN equalityD2, THEN subset_trans])
    47 apply (rule nat_0I [THEN UN_upper])
    48 done
    49 
    50 lemmas arg_into_eclose = arg_subset_eclose [THEN subsetD, standard]
    51 
    52 lemma Transset_eclose: "Transset(eclose(A))"
    53 apply (unfold eclose_def Transset_def)
    54 apply (rule subsetI [THEN ballI])
    55 apply (erule UN_E)
    56 apply (rule nat_succI [THEN UN_I], assumption)
    57 apply (erule nat_rec_succ [THEN ssubst])
    58 apply (erule UnionI, assumption)
    59 done
    60 
    61 (* x : eclose(A) ==> x <= eclose(A) *)
    62 lemmas eclose_subset =  
    63        Transset_eclose [unfolded Transset_def, THEN bspec, standard]
    64 
    65 (* [| A : eclose(B); c : A |] ==> c : eclose(B) *)
    66 lemmas ecloseD = eclose_subset [THEN subsetD, standard]
    67 
    68 lemmas arg_in_eclose_sing = arg_subset_eclose [THEN singleton_subsetD]
    69 lemmas arg_into_eclose_sing = arg_in_eclose_sing [THEN ecloseD, standard]
    70 
    71 (* This is epsilon-induction for eclose(A); see also eclose_induct_down...
    72    [| a: eclose(A);  !!x. [| x: eclose(A); ALL y:x. P(y) |] ==> P(x) 
    73    |] ==> P(a) 
    74 *)
    75 lemmas eclose_induct =
    76      Transset_induct [OF _ Transset_eclose, induct set: eclose]
    77 
    78 
    79 (*Epsilon induction*)
    80 lemma eps_induct:
    81     "[| !!x. ALL y:x. P(y) ==> P(x) |]  ==>  P(a)"
    82 by (rule arg_in_eclose_sing [THEN eclose_induct], blast) 
    83 
    84 
    85 subsection{*Leastness of @{term eclose}*}
    86 
    87 (** eclose(A) is the least transitive set including A as a subset. **)
    88 
    89 lemma eclose_least_lemma: 
    90     "[| Transset(X);  A<=X;  n: nat |] ==> nat_rec(n, A, %m r. Union(r)) <= X"
    91 apply (unfold Transset_def)
    92 apply (erule nat_induct) 
    93 apply (simp add: nat_rec_0)
    94 apply (simp add: nat_rec_succ, blast)
    95 done
    96 
    97 lemma eclose_least: 
    98      "[| Transset(X);  A<=X |] ==> eclose(A) <= X"
    99 apply (unfold eclose_def)
   100 apply (rule eclose_least_lemma [THEN UN_least], assumption+)
   101 done
   102 
   103 (*COMPLETELY DIFFERENT induction principle from eclose_induct!!*)
   104 lemma eclose_induct_down [consumes 1]:
   105     "[| a: eclose(b);                                            
   106         !!y.   [| y: b |] ==> P(y);                              
   107         !!y z. [| y: eclose(b);  P(y);  z: y |] ==> P(z)         
   108      |] ==> P(a)"
   109 apply (rule eclose_least [THEN subsetD, THEN CollectD2, of "eclose(b)"])
   110   prefer 3 apply assumption
   111  apply (unfold Transset_def) 
   112  apply (blast intro: ecloseD)
   113 apply (blast intro: arg_subset_eclose [THEN subsetD])
   114 done
   115 
   116 lemma Transset_eclose_eq_arg: "Transset(X) ==> eclose(X) = X"
   117 apply (erule equalityI [OF eclose_least arg_subset_eclose])
   118 apply (rule subset_refl)
   119 done
   120 
   121 text{*A transitive set either is empty or contains the empty set.*}
   122 lemma Transset_0_lemma [rule_format]: "Transset(A) ==> x\<in>A --> 0\<in>A";
   123 apply (simp add: Transset_def) 
   124 apply (rule_tac a=x in eps_induct, clarify) 
   125 apply (drule bspec, assumption) 
   126 apply (case_tac "x=0", auto)
   127 done
   128 
   129 lemma Transset_0_disj: "Transset(A) ==> A=0 | 0\<in>A";
   130 by (blast dest: Transset_0_lemma)
   131 
   132 
   133 subsection{*Epsilon Recursion*}
   134 
   135 (*Unused...*)
   136 lemma mem_eclose_trans: "[| A: eclose(B);  B: eclose(C) |] ==> A: eclose(C)"
   137 by (rule eclose_least [OF Transset_eclose eclose_subset, THEN subsetD], 
   138     assumption+)
   139 
   140 (*Variant of the previous lemma in a useable form for the sequel*)
   141 lemma mem_eclose_sing_trans:
   142      "[| A: eclose({B});  B: eclose({C}) |] ==> A: eclose({C})"
   143 by (rule eclose_least [OF Transset_eclose singleton_subsetI, THEN subsetD], 
   144     assumption+)
   145 
   146 lemma under_Memrel: "[| Transset(i);  j:i |] ==> Memrel(i)-``{j} = j"
   147 by (unfold Transset_def, blast)
   148 
   149 lemma lt_Memrel: "j < i ==> Memrel(i) -`` {j} = j"
   150 by (simp add: lt_def Ord_def under_Memrel) 
   151 
   152 (* j : eclose(A) ==> Memrel(eclose(A)) -`` j = j *)
   153 lemmas under_Memrel_eclose = Transset_eclose [THEN under_Memrel, standard]
   154 
   155 lemmas wfrec_ssubst = wf_Memrel [THEN wfrec, THEN ssubst]
   156 
   157 lemma wfrec_eclose_eq:
   158     "[| k:eclose({j});  j:eclose({i}) |] ==>  
   159      wfrec(Memrel(eclose({i})), k, H) = wfrec(Memrel(eclose({j})), k, H)"
   160 apply (erule eclose_induct)
   161 apply (rule wfrec_ssubst)
   162 apply (rule wfrec_ssubst)
   163 apply (simp add: under_Memrel_eclose mem_eclose_sing_trans [of _ j i])
   164 done
   165 
   166 lemma wfrec_eclose_eq2: 
   167     "k: i ==> wfrec(Memrel(eclose({i})),k,H) = wfrec(Memrel(eclose({k})),k,H)"
   168 apply (rule arg_in_eclose_sing [THEN wfrec_eclose_eq])
   169 apply (erule arg_into_eclose_sing)
   170 done
   171 
   172 lemma transrec: "transrec(a,H) = H(a, lam x:a. transrec(x,H))"
   173 apply (unfold transrec_def)
   174 apply (rule wfrec_ssubst)
   175 apply (simp add: wfrec_eclose_eq2 arg_in_eclose_sing under_Memrel_eclose)
   176 done
   177 
   178 (*Avoids explosions in proofs; resolve it with a meta-level definition.*)
   179 lemma def_transrec:
   180     "[| !!x. f(x)==transrec(x,H) |] ==> f(a) = H(a, lam x:a. f(x))"
   181 apply simp
   182 apply (rule transrec)
   183 done
   184 
   185 lemma transrec_type:
   186     "[| !!x u. [| x:eclose({a});  u: Pi(x,B) |] ==> H(x,u) : B(x) |]
   187      ==> transrec(a,H) : B(a)"
   188 apply (rule_tac i = a in arg_in_eclose_sing [THEN eclose_induct])
   189 apply (subst transrec)
   190 apply (simp add: lam_type) 
   191 done
   192 
   193 lemma eclose_sing_Ord: "Ord(i) ==> eclose({i}) <= succ(i)"
   194 apply (erule Ord_is_Transset [THEN Transset_succ, THEN eclose_least])
   195 apply (rule succI1 [THEN singleton_subsetI])
   196 done
   197 
   198 lemma succ_subset_eclose_sing: "succ(i) <= eclose({i})"
   199 apply (insert arg_subset_eclose [of "{i}"], simp) 
   200 apply (frule eclose_subset, blast) 
   201 done
   202 
   203 lemma eclose_sing_Ord_eq: "Ord(i) ==> eclose({i}) = succ(i)"
   204 apply (rule equalityI)
   205 apply (erule eclose_sing_Ord)  
   206 apply (rule succ_subset_eclose_sing) 
   207 done
   208 
   209 lemma Ord_transrec_type:
   210   assumes jini: "j: i"
   211       and ordi: "Ord(i)"
   212       and minor: " !!x u. [| x: i;  u: Pi(x,B) |] ==> H(x,u) : B(x)"
   213   shows "transrec(j,H) : B(j)"
   214 apply (rule transrec_type)
   215 apply (insert jini ordi)
   216 apply (blast intro!: minor
   217              intro: Ord_trans 
   218              dest: Ord_in_Ord [THEN eclose_sing_Ord, THEN subsetD])
   219 done
   220 
   221 subsection{*Rank*}
   222 
   223 (*NOT SUITABLE FOR REWRITING -- RECURSIVE!*)
   224 lemma rank: "rank(a) = (\<Union>y\<in>a. succ(rank(y)))"
   225 by (subst rank_def [THEN def_transrec], simp)
   226 
   227 lemma Ord_rank [simp]: "Ord(rank(a))"
   228 apply (rule_tac a=a in eps_induct) 
   229 apply (subst rank)
   230 apply (rule Ord_succ [THEN Ord_UN])
   231 apply (erule bspec, assumption)
   232 done
   233 
   234 lemma rank_of_Ord: "Ord(i) ==> rank(i) = i"
   235 apply (erule trans_induct)
   236 apply (subst rank)
   237 apply (simp add: Ord_equality)
   238 done
   239 
   240 lemma rank_lt: "a:b ==> rank(a) < rank(b)"
   241 apply (rule_tac a1 = b in rank [THEN ssubst])
   242 apply (erule UN_I [THEN ltI])
   243 apply (rule_tac [2] Ord_UN, auto)
   244 done
   245 
   246 lemma eclose_rank_lt: "a: eclose(b) ==> rank(a) < rank(b)"
   247 apply (erule eclose_induct_down)
   248 apply (erule rank_lt)
   249 apply (erule rank_lt [THEN lt_trans], assumption)
   250 done
   251 
   252 lemma rank_mono: "a<=b ==> rank(a) le rank(b)"
   253 apply (rule subset_imp_le)
   254 apply (auto simp add: rank [of a] rank [of b]) 
   255 done
   256 
   257 lemma rank_Pow: "rank(Pow(a)) = succ(rank(a))"
   258 apply (rule rank [THEN trans])
   259 apply (rule le_anti_sym)
   260 apply (rule_tac [2] UN_upper_le)
   261 apply (rule UN_least_le)
   262 apply (auto intro: rank_mono simp add: Ord_UN)
   263 done
   264 
   265 lemma rank_0 [simp]: "rank(0) = 0"
   266 by (rule rank [THEN trans], blast)
   267 
   268 lemma rank_succ [simp]: "rank(succ(x)) = succ(rank(x))"
   269 apply (rule rank [THEN trans])
   270 apply (rule equalityI [OF UN_least succI1 [THEN UN_upper]])
   271 apply (erule succE, blast)
   272 apply (erule rank_lt [THEN leI, THEN succ_leI, THEN le_imp_subset])
   273 done
   274 
   275 lemma rank_Union: "rank(Union(A)) = (\<Union>x\<in>A. rank(x))"
   276 apply (rule equalityI)
   277 apply (rule_tac [2] rank_mono [THEN le_imp_subset, THEN UN_least])
   278 apply (erule_tac [2] Union_upper)
   279 apply (subst rank)
   280 apply (rule UN_least)
   281 apply (erule UnionE)
   282 apply (rule subset_trans)
   283 apply (erule_tac [2] RepFunI [THEN Union_upper])
   284 apply (erule rank_lt [THEN succ_leI, THEN le_imp_subset])
   285 done
   286 
   287 lemma rank_eclose: "rank(eclose(a)) = rank(a)"
   288 apply (rule le_anti_sym)
   289 apply (rule_tac [2] arg_subset_eclose [THEN rank_mono])
   290 apply (rule_tac a1 = "eclose (a) " in rank [THEN ssubst])
   291 apply (rule Ord_rank [THEN UN_least_le])
   292 apply (erule eclose_rank_lt [THEN succ_leI])
   293 done
   294 
   295 lemma rank_pair1: "rank(a) < rank(<a,b>)"
   296 apply (unfold Pair_def)
   297 apply (rule consI1 [THEN rank_lt, THEN lt_trans])
   298 apply (rule consI1 [THEN consI2, THEN rank_lt])
   299 done
   300 
   301 lemma rank_pair2: "rank(b) < rank(<a,b>)"
   302 apply (unfold Pair_def)
   303 apply (rule consI1 [THEN consI2, THEN rank_lt, THEN lt_trans])
   304 apply (rule consI1 [THEN consI2, THEN rank_lt])
   305 done
   306 
   307 (*Not clear how to remove the P(a) condition, since the "then" part
   308   must refer to "a"*)
   309 lemma the_equality_if:
   310      "P(a) ==> (THE x. P(x)) = (if (EX!x. P(x)) then a else 0)"
   311 by (simp add: the_0 the_equality2)
   312 
   313 (*The first premise not only fixs i but ensures f~=0.
   314   The second premise is now essential.  Consider otherwise the relation 
   315   r = {<0,0>,<0,1>,<0,2>,...}.  Then f`0 = Union(f``{0}) = Union(nat) = nat,
   316   whose rank equals that of r.*)
   317 lemma rank_apply: "[|i : domain(f); function(f)|] ==> rank(f`i) < rank(f)"
   318 apply clarify  
   319 apply (simp add: function_apply_equality) 
   320 apply (blast intro: lt_trans rank_lt rank_pair2)
   321 done
   322 
   323 
   324 subsection{*Corollaries of Leastness*}
   325 
   326 lemma mem_eclose_subset: "A:B ==> eclose(A)<=eclose(B)"
   327 apply (rule Transset_eclose [THEN eclose_least])
   328 apply (erule arg_into_eclose [THEN eclose_subset])
   329 done
   330 
   331 lemma eclose_mono: "A<=B ==> eclose(A) <= eclose(B)"
   332 apply (rule Transset_eclose [THEN eclose_least])
   333 apply (erule subset_trans)
   334 apply (rule arg_subset_eclose)
   335 done
   336 
   337 (** Idempotence of eclose **)
   338 
   339 lemma eclose_idem: "eclose(eclose(A)) = eclose(A)"
   340 apply (rule equalityI)
   341 apply (rule eclose_least [OF Transset_eclose subset_refl])
   342 apply (rule arg_subset_eclose)
   343 done
   344 
   345 (** Transfinite recursion for definitions based on the 
   346     three cases of ordinals **)
   347 
   348 lemma transrec2_0 [simp]: "transrec2(0,a,b) = a"
   349 by (rule transrec2_def [THEN def_transrec, THEN trans], simp)
   350 
   351 lemma transrec2_succ [simp]: "transrec2(succ(i),a,b) = b(i, transrec2(i,a,b))"
   352 apply (rule transrec2_def [THEN def_transrec, THEN trans])
   353 apply (simp add: the_equality if_P)
   354 done
   355 
   356 lemma transrec2_Limit:
   357      "Limit(i) ==> transrec2(i,a,b) = (\<Union>j<i. transrec2(j,a,b))"
   358 apply (rule transrec2_def [THEN def_transrec, THEN trans])
   359 apply (auto simp add: OUnion_def) 
   360 done
   361 
   362 lemma def_transrec2:
   363      "(!!x. f(x)==transrec2(x,a,b))
   364       ==> f(0) = a & 
   365           f(succ(i)) = b(i, f(i)) & 
   366           (Limit(K) --> f(K) = (\<Union>j<K. f(j)))"
   367 by (simp add: transrec2_Limit)
   368 
   369 
   370 (** recursor -- better than nat_rec; the succ case has no type requirement! **)
   371 
   372 (*NOT suitable for rewriting*)
   373 lemmas recursor_lemma = recursor_def [THEN def_transrec, THEN trans]
   374 
   375 lemma recursor_0: "recursor(a,b,0) = a"
   376 by (rule nat_case_0 [THEN recursor_lemma])
   377 
   378 lemma recursor_succ: "recursor(a,b,succ(m)) = b(m, recursor(a,b,m))"
   379 by (rule recursor_lemma, simp)
   380 
   381 
   382 (** rec: old version for compatibility **)
   383 
   384 lemma rec_0 [simp]: "rec(0,a,b) = a"
   385 apply (unfold rec_def)
   386 apply (rule recursor_0)
   387 done
   388 
   389 lemma rec_succ [simp]: "rec(succ(m),a,b) = b(m, rec(m,a,b))"
   390 apply (unfold rec_def)
   391 apply (rule recursor_succ)
   392 done
   393 
   394 lemma rec_type:
   395     "[| n: nat;   
   396         a: C(0);   
   397         !!m z. [| m: nat;  z: C(m) |] ==> b(m,z): C(succ(m)) |]
   398      ==> rec(n,a,b) : C(n)"
   399 by (erule nat_induct, auto)
   400 
   401 ML
   402 {*
   403 val arg_subset_eclose = thm "arg_subset_eclose";
   404 val arg_into_eclose = thm "arg_into_eclose";
   405 val Transset_eclose = thm "Transset_eclose";
   406 val eclose_subset = thm "eclose_subset";
   407 val ecloseD = thm "ecloseD";
   408 val arg_in_eclose_sing = thm "arg_in_eclose_sing";
   409 val arg_into_eclose_sing = thm "arg_into_eclose_sing";
   410 val eclose_induct = thm "eclose_induct";
   411 val eps_induct = thm "eps_induct";
   412 val eclose_least = thm "eclose_least";
   413 val eclose_induct_down = thm "eclose_induct_down";
   414 val Transset_eclose_eq_arg = thm "Transset_eclose_eq_arg";
   415 val mem_eclose_trans = thm "mem_eclose_trans";
   416 val mem_eclose_sing_trans = thm "mem_eclose_sing_trans";
   417 val under_Memrel = thm "under_Memrel";
   418 val under_Memrel_eclose = thm "under_Memrel_eclose";
   419 val wfrec_ssubst = thm "wfrec_ssubst";
   420 val wfrec_eclose_eq = thm "wfrec_eclose_eq";
   421 val wfrec_eclose_eq2 = thm "wfrec_eclose_eq2";
   422 val transrec = thm "transrec";
   423 val def_transrec = thm "def_transrec";
   424 val transrec_type = thm "transrec_type";
   425 val eclose_sing_Ord = thm "eclose_sing_Ord";
   426 val Ord_transrec_type = thm "Ord_transrec_type";
   427 val rank = thm "rank";
   428 val Ord_rank = thm "Ord_rank";
   429 val rank_of_Ord = thm "rank_of_Ord";
   430 val rank_lt = thm "rank_lt";
   431 val eclose_rank_lt = thm "eclose_rank_lt";
   432 val rank_mono = thm "rank_mono";
   433 val rank_Pow = thm "rank_Pow";
   434 val rank_0 = thm "rank_0";
   435 val rank_succ = thm "rank_succ";
   436 val rank_Union = thm "rank_Union";
   437 val rank_eclose = thm "rank_eclose";
   438 val rank_pair1 = thm "rank_pair1";
   439 val rank_pair2 = thm "rank_pair2";
   440 val the_equality_if = thm "the_equality_if";
   441 val rank_apply = thm "rank_apply";
   442 val mem_eclose_subset = thm "mem_eclose_subset";
   443 val eclose_mono = thm "eclose_mono";
   444 val eclose_idem = thm "eclose_idem";
   445 val transrec2_0 = thm "transrec2_0";
   446 val transrec2_succ = thm "transrec2_succ";
   447 val transrec2_Limit = thm "transrec2_Limit";
   448 val recursor_0 = thm "recursor_0";
   449 val recursor_succ = thm "recursor_succ";
   450 val rec_0 = thm "rec_0";
   451 val rec_succ = thm "rec_succ";
   452 val rec_type = thm "rec_type";
   453 *}
   454 
   455 end