src/ZF/WF.thy
changeset 46820 c656222c4dc1
parent 45602 2a858377c3d2
child 46821 ff6b0c1087f2
equal deleted inserted replaced
46819:9b38f8527510 46820:c656222c4dc1
    19 theory WF imports Trancl begin
    19 theory WF imports Trancl begin
    20 
    20 
    21 definition
    21 definition
    22   wf           :: "i=>o"  where
    22   wf           :: "i=>o"  where
    23     (*r is a well-founded relation*)
    23     (*r is a well-founded relation*)
    24     "wf(r) == ALL Z. Z=0 | (EX x:Z. ALL y. <y,x>:r --> ~ y:Z)"
    24     "wf(r) == \<forall>Z. Z=0 | (\<exists>x\<in>Z. \<forall>y. <y,x>:r \<longrightarrow> ~ y:Z)"
    25 
    25 
    26 definition
    26 definition
    27   wf_on        :: "[i,i]=>o"                      ("wf[_]'(_')")  where
    27   wf_on        :: "[i,i]=>o"                      ("wf[_]'(_')")  where
    28     (*r is well-founded on A*)
    28     (*r is well-founded on A*)
    29     "wf_on(A,r) == wf(r Int A*A)"
    29     "wf_on(A,r) == wf(r \<inter> A*A)"
    30 
    30 
    31 definition
    31 definition
    32   is_recfun    :: "[i, i, [i,i]=>i, i] =>o"  where
    32   is_recfun    :: "[i, i, [i,i]=>i, i] =>o"  where
    33     "is_recfun(r,a,H,f) == (f = (lam x: r-``{a}. H(x, restrict(f, r-``{x}))))"
    33     "is_recfun(r,a,H,f) == (f = (\<lambda>x\<in>r-``{a}. H(x, restrict(f, r-``{x}))))"
    34 
    34 
    35 definition
    35 definition
    36   the_recfun   :: "[i, i, [i,i]=>i] =>i"  where
    36   the_recfun   :: "[i, i, [i,i]=>i] =>i"  where
    37     "the_recfun(r,a,H) == (THE f. is_recfun(r,a,H,f))"
    37     "the_recfun(r,a,H) == (THE f. is_recfun(r,a,H,f))"
    38 
    38 
    45     (*public version.  Does not require r to be transitive*)
    45     (*public version.  Does not require r to be transitive*)
    46     "wfrec(r,a,H) == wftrec(r^+, a, %x f. H(x, restrict(f,r-``{x})))"
    46     "wfrec(r,a,H) == wftrec(r^+, a, %x f. H(x, restrict(f,r-``{x})))"
    47 
    47 
    48 definition
    48 definition
    49   wfrec_on     :: "[i, i, i, [i,i]=>i] =>i"       ("wfrec[_]'(_,_,_')")  where
    49   wfrec_on     :: "[i, i, i, [i,i]=>i] =>i"       ("wfrec[_]'(_,_,_')")  where
    50     "wfrec[A](r,a,H) == wfrec(r Int A*A, a, H)"
    50     "wfrec[A](r,a,H) == wfrec(r \<inter> A*A, a, H)"
    51 
    51 
    52 
    52 
    53 subsection{*Well-Founded Relations*}
    53 subsection{*Well-Founded Relations*}
    54 
    54 
    55 subsubsection{*Equivalences between @{term wf} and @{term wf_on}*}
    55 subsubsection{*Equivalences between @{term wf} and @{term wf_on}*}
    56 
    56 
    57 lemma wf_imp_wf_on: "wf(r) ==> wf[A](r)"
    57 lemma wf_imp_wf_on: "wf(r) ==> wf[A](r)"
    58 by (unfold wf_def wf_on_def, force) 
    58 by (unfold wf_def wf_on_def, force)
    59 
    59 
    60 lemma wf_on_imp_wf: "[|wf[A](r); r <= A*A|] ==> wf(r)";
    60 lemma wf_on_imp_wf: "[|wf[A](r); r \<subseteq> A*A|] ==> wf(r)";
    61 by (simp add: wf_on_def subset_Int_iff)
    61 by (simp add: wf_on_def subset_Int_iff)
    62 
    62 
    63 lemma wf_on_field_imp_wf: "wf[field(r)](r) ==> wf(r)"
    63 lemma wf_on_field_imp_wf: "wf[field(r)](r) ==> wf(r)"
    64 by (unfold wf_def wf_on_def, fast)
    64 by (unfold wf_def wf_on_def, fast)
    65 
    65 
    78 subsubsection{*Introduction Rules for @{term wf_on}*}
    78 subsubsection{*Introduction Rules for @{term wf_on}*}
    79 
    79 
    80 text{*If every non-empty subset of @{term A} has an @{term r}-minimal element
    80 text{*If every non-empty subset of @{term A} has an @{term r}-minimal element
    81    then we have @{term "wf[A](r)"}.*}
    81    then we have @{term "wf[A](r)"}.*}
    82 lemma wf_onI:
    82 lemma wf_onI:
    83  assumes prem: "!!Z u. [| Z<=A;  u:Z;  ALL x:Z. EX y:Z. <y,x>:r |] ==> False"
    83  assumes prem: "!!Z u. [| Z<=A;  u:Z;  \<forall>x\<in>Z. \<exists>y\<in>Z. <y,x>:r |] ==> False"
    84  shows         "wf[A](r)"
    84  shows         "wf[A](r)"
    85 apply (unfold wf_on_def wf_def)
    85 apply (unfold wf_on_def wf_def)
    86 apply (rule equals0I [THEN disjCI, THEN allI])
    86 apply (rule equals0I [THEN disjCI, THEN allI])
    87 apply (rule_tac Z = Z in prem, blast+)
    87 apply (rule_tac Z = Z in prem, blast+)
    88 done
    88 done
    89 
    89 
    90 text{*If @{term r} allows well-founded induction over @{term A}
    90 text{*If @{term r} allows well-founded induction over @{term A}
    91    then we have @{term "wf[A](r)"}.   Premise is equivalent to
    91    then we have @{term "wf[A](r)"}.   Premise is equivalent to
    92   @{prop "!!B. ALL x:A. (ALL y. <y,x>: r --> y:B) --> x:B ==> A<=B"} *}
    92   @{prop "!!B. \<forall>x\<in>A. (\<forall>y. <y,x>: r \<longrightarrow> y:B) \<longrightarrow> x:B ==> A<=B"} *}
    93 lemma wf_onI2:
    93 lemma wf_onI2:
    94  assumes prem: "!!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B;   y:A |]
    94  assumes prem: "!!y B. [| \<forall>x\<in>A. (\<forall>y\<in>A. <y,x>:r \<longrightarrow> y:B) \<longrightarrow> x:B;   y:A |]
    95                        ==> y:B"
    95                        ==> y:B"
    96  shows         "wf[A](r)"
    96  shows         "wf[A](r)"
    97 apply (rule wf_onI)
    97 apply (rule wf_onI)
    98 apply (rule_tac c=u in prem [THEN DiffE])
    98 apply (rule_tac c=u in prem [THEN DiffE])
    99   prefer 3 apply blast 
    99   prefer 3 apply blast
   100  apply fast+
   100  apply fast+
   101 done
   101 done
   102 
   102 
   103 
   103 
   104 subsubsection{*Well-founded Induction*}
   104 subsubsection{*Well-founded Induction*}
   105 
   105 
   106 text{*Consider the least @{term z} in @{term "domain(r)"} such that
   106 text{*Consider the least @{term z} in @{term "domain(r)"} such that
   107   @{term "P(z)"} does not hold...*}
   107   @{term "P(z)"} does not hold...*}
   108 lemma wf_induct [induct set: wf]:
   108 lemma wf_induct [induct set: wf]:
   109     "[| wf(r);
   109     "[| wf(r);
   110         !!x.[| ALL y. <y,x>: r --> P(y) |] ==> P(x) |]  
   110         !!x.[| \<forall>y. <y,x>: r \<longrightarrow> P(y) |] ==> P(x) |]
   111      ==> P(a)"
   111      ==> P(a)"
   112 apply (unfold wf_def) 
   112 apply (unfold wf_def)
   113 apply (erule_tac x = "{z : domain(r). ~ P(z)}" in allE)
   113 apply (erule_tac x = "{z \<in> domain(r). ~ P(z)}" in allE)
   114 apply blast 
   114 apply blast
   115 done
   115 done
   116 
   116 
   117 lemmas wf_induct_rule = wf_induct [rule_format, induct set: wf]
   117 lemmas wf_induct_rule = wf_induct [rule_format, induct set: wf]
   118 
   118 
   119 text{*The form of this rule is designed to match @{text wfI}*}
   119 text{*The form of this rule is designed to match @{text wfI}*}
   120 lemma wf_induct2:
   120 lemma wf_induct2:
   121     "[| wf(r);  a:A;  field(r)<=A;
   121     "[| wf(r);  a:A;  field(r)<=A;
   122         !!x.[| x: A;  ALL y. <y,x>: r --> P(y) |] ==> P(x) |]
   122         !!x.[| x: A;  \<forall>y. <y,x>: r \<longrightarrow> P(y) |] ==> P(x) |]
   123      ==>  P(a)"
   123      ==>  P(a)"
   124 apply (erule_tac P="a:A" in rev_mp)
   124 apply (erule_tac P="a:A" in rev_mp)
   125 apply (erule_tac a=a in wf_induct, blast) 
   125 apply (erule_tac a=a in wf_induct, blast)
   126 done
   126 done
   127 
   127 
   128 lemma field_Int_square: "field(r Int A*A) <= A"
   128 lemma field_Int_square: "field(r \<inter> A*A) \<subseteq> A"
   129 by blast
   129 by blast
   130 
   130 
   131 lemma wf_on_induct [consumes 2, induct set: wf_on]:
   131 lemma wf_on_induct [consumes 2, induct set: wf_on]:
   132     "[| wf[A](r);  a:A;
   132     "[| wf[A](r);  a:A;
   133         !!x.[| x: A;  ALL y:A. <y,x>: r --> P(y) |] ==> P(x)
   133         !!x.[| x: A;  \<forall>y\<in>A. <y,x>: r \<longrightarrow> P(y) |] ==> P(x)
   134      |]  ==>  P(a)"
   134      |]  ==>  P(a)"
   135 apply (unfold wf_on_def) 
   135 apply (unfold wf_on_def)
   136 apply (erule wf_induct2, assumption)
   136 apply (erule wf_induct2, assumption)
   137 apply (rule field_Int_square, blast)
   137 apply (rule field_Int_square, blast)
   138 done
   138 done
   139 
   139 
   140 lemmas wf_on_induct_rule =
   140 lemmas wf_on_induct_rule =
   141   wf_on_induct [rule_format, consumes 2, induct set: wf_on]
   141   wf_on_induct [rule_format, consumes 2, induct set: wf_on]
   142 
   142 
   143 
   143 
   144 text{*If @{term r} allows well-founded induction 
   144 text{*If @{term r} allows well-founded induction
   145    then we have @{term "wf(r)"}.*}
   145    then we have @{term "wf(r)"}.*}
   146 lemma wfI:
   146 lemma wfI:
   147     "[| field(r)<=A;
   147     "[| field(r)<=A;
   148         !!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B;  y:A|]
   148         !!y B. [| \<forall>x\<in>A. (\<forall>y\<in>A. <y,x>:r \<longrightarrow> y:B) \<longrightarrow> x:B;  y:A|]
   149                ==> y:B |]
   149                ==> y:B |]
   150      ==>  wf(r)"
   150      ==>  wf(r)"
   151 apply (rule wf_on_subset_A [THEN wf_on_field_imp_wf])
   151 apply (rule wf_on_subset_A [THEN wf_on_field_imp_wf])
   152 apply (rule wf_onI2)
   152 apply (rule wf_onI2)
   153  prefer 2 apply blast  
   153  prefer 2 apply blast
   154 apply blast 
   154 apply blast
   155 done
   155 done
   156 
   156 
   157 
   157 
   158 subsection{*Basic Properties of Well-Founded Relations*}
   158 subsection{*Basic Properties of Well-Founded Relations*}
   159 
   159 
   160 lemma wf_not_refl: "wf(r) ==> <a,a> ~: r"
   160 lemma wf_not_refl: "wf(r) ==> <a,a> \<notin> r"
   161 by (erule_tac a=a in wf_induct, blast)
   161 by (erule_tac a=a in wf_induct, blast)
   162 
   162 
   163 lemma wf_not_sym [rule_format]: "wf(r) ==> ALL x. <a,x>:r --> <x,a> ~: r"
   163 lemma wf_not_sym [rule_format]: "wf(r) ==> \<forall>x. <a,x>:r \<longrightarrow> <x,a> \<notin> r"
   164 by (erule_tac a=a in wf_induct, blast)
   164 by (erule_tac a=a in wf_induct, blast)
   165 
   165 
   166 (* [| wf(r);  <a,x> : r;  ~P ==> <x,a> : r |] ==> P *)
   166 (* @{term"[| wf(r);  <a,x> \<in> r;  ~P ==> <x,a> \<in> r |] ==> P"} *)
   167 lemmas wf_asym = wf_not_sym [THEN swap]
   167 lemmas wf_asym = wf_not_sym [THEN swap]
   168 
   168 
   169 lemma wf_on_not_refl: "[| wf[A](r); a: A |] ==> <a,a> ~: r"
   169 lemma wf_on_not_refl: "[| wf[A](r); a: A |] ==> <a,a> \<notin> r"
   170 by (erule_tac a=a in wf_on_induct, assumption, blast)
   170 by (erule_tac a=a in wf_on_induct, assumption, blast)
   171 
   171 
   172 lemma wf_on_not_sym [rule_format]:
   172 lemma wf_on_not_sym [rule_format]:
   173      "[| wf[A](r);  a:A |] ==> ALL b:A. <a,b>:r --> <b,a>~:r"
   173      "[| wf[A](r);  a:A |] ==> \<forall>b\<in>A. <a,b>:r \<longrightarrow> <b,a>\<notin>r"
   174 apply (erule_tac a=a in wf_on_induct, assumption, blast)
   174 apply (erule_tac a=a in wf_on_induct, assumption, blast)
   175 done
   175 done
   176 
   176 
   177 lemma wf_on_asym:
   177 lemma wf_on_asym:
   178      "[| wf[A](r);  ~Z ==> <a,b> : r;
   178      "[| wf[A](r);  ~Z ==> <a,b> \<in> r;
   179          <b,a> ~: r ==> Z; ~Z ==> a : A; ~Z ==> b : A |] ==> Z"
   179          <b,a> \<notin> r ==> Z; ~Z ==> a \<in> A; ~Z ==> b \<in> A |] ==> Z"
   180 by (blast dest: wf_on_not_sym) 
   180 by (blast dest: wf_on_not_sym)
   181 
   181 
   182 
   182 
   183 (*Needed to prove well_ordI.  Could also reason that wf[A](r) means
   183 (*Needed to prove well_ordI.  Could also reason that wf[A](r) means
   184   wf(r Int A*A);  thus wf( (r Int A*A)^+ ) and use wf_not_refl *)
   184   wf(r \<inter> A*A);  thus wf( (r \<inter> A*A)^+ ) and use wf_not_refl *)
   185 lemma wf_on_chain3:
   185 lemma wf_on_chain3:
   186      "[| wf[A](r); <a,b>:r; <b,c>:r; <c,a>:r; a:A; b:A; c:A |] ==> P"
   186      "[| wf[A](r); <a,b>:r; <b,c>:r; <c,a>:r; a:A; b:A; c:A |] ==> P"
   187 apply (subgoal_tac "ALL y:A. ALL z:A. <a,y>:r --> <y,z>:r --> <z,a>:r --> P",
   187 apply (subgoal_tac "\<forall>y\<in>A. \<forall>z\<in>A. <a,y>:r \<longrightarrow> <y,z>:r \<longrightarrow> <z,a>:r \<longrightarrow> P",
   188        blast) 
   188        blast)
   189 apply (erule_tac a=a in wf_on_induct, assumption, blast)
   189 apply (erule_tac a=a in wf_on_induct, assumption, blast)
   190 done
   190 done
   191 
   191 
   192 
   192 
   193 
   193 
   194 text{*transitive closure of a WF relation is WF provided 
   194 text{*transitive closure of a WF relation is WF provided
   195   @{term A} is downward closed*}
   195   @{term A} is downward closed*}
   196 lemma wf_on_trancl:
   196 lemma wf_on_trancl:
   197     "[| wf[A](r);  r-``A <= A |] ==> wf[A](r^+)"
   197     "[| wf[A](r);  r-``A \<subseteq> A |] ==> wf[A](r^+)"
   198 apply (rule wf_onI2)
   198 apply (rule wf_onI2)
   199 apply (frule bspec [THEN mp], assumption+)
   199 apply (frule bspec [THEN mp], assumption+)
   200 apply (erule_tac a = y in wf_on_induct, assumption)
   200 apply (erule_tac a = y in wf_on_induct, assumption)
   201 apply (blast elim: tranclE, blast) 
   201 apply (blast elim: tranclE, blast)
   202 done
   202 done
   203 
   203 
   204 lemma wf_trancl: "wf(r) ==> wf(r^+)"
   204 lemma wf_trancl: "wf(r) ==> wf(r^+)"
   205 apply (simp add: wf_iff_wf_on_field)
   205 apply (simp add: wf_iff_wf_on_field)
   206 apply (rule wf_on_subset_A) 
   206 apply (rule wf_on_subset_A)
   207  apply (erule wf_on_trancl)
   207  apply (erule wf_on_trancl)
   208  apply blast 
   208  apply blast
   209 apply (rule trancl_type [THEN field_rel_subset])
   209 apply (rule trancl_type [THEN field_rel_subset])
   210 done
   210 done
   211 
   211 
   212 
   212 
   213 text{*@{term "r-``{a}"} is the set of everything under @{term a} in @{term r}*}
   213 text{*@{term "r-``{a}"} is the set of everything under @{term a} in @{term r}*}
   226 
   226 
   227 lemmas is_recfun_imp_function = is_recfun_type [THEN fun_is_function]
   227 lemmas is_recfun_imp_function = is_recfun_type [THEN fun_is_function]
   228 
   228 
   229 lemma apply_recfun:
   229 lemma apply_recfun:
   230     "[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))"
   230     "[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))"
   231 apply (unfold is_recfun_def) 
   231 apply (unfold is_recfun_def)
   232   txt{*replace f only on the left-hand side*}
   232   txt{*replace f only on the left-hand side*}
   233 apply (erule_tac P = "%x.?t(x) = ?u" in ssubst)
   233 apply (erule_tac P = "%x.?t(x) = ?u" in ssubst)
   234 apply (simp add: underI) 
   234 apply (simp add: underI)
   235 done
   235 done
   236 
   236 
   237 lemma is_recfun_equal [rule_format]:
   237 lemma is_recfun_equal [rule_format]:
   238      "[| wf(r);  trans(r);  is_recfun(r,a,H,f);  is_recfun(r,b,H,g) |]
   238      "[| wf(r);  trans(r);  is_recfun(r,a,H,f);  is_recfun(r,b,H,g) |]
   239       ==> <x,a>:r --> <x,b>:r --> f`x=g`x"
   239       ==> <x,a>:r \<longrightarrow> <x,b>:r \<longrightarrow> f`x=g`x"
   240 apply (frule_tac f = f in is_recfun_type)
   240 apply (frule_tac f = f in is_recfun_type)
   241 apply (frule_tac f = g in is_recfun_type)
   241 apply (frule_tac f = g in is_recfun_type)
   242 apply (simp add: is_recfun_def)
   242 apply (simp add: is_recfun_def)
   243 apply (erule_tac a=x in wf_induct)
   243 apply (erule_tac a=x in wf_induct)
   244 apply (intro impI)
   244 apply (intro impI)
   245 apply (elim ssubst)
   245 apply (elim ssubst)
   246 apply (simp (no_asm_simp) add: vimage_singleton_iff restrict_def)
   246 apply (simp (no_asm_simp) add: vimage_singleton_iff restrict_def)
   247 apply (rule_tac t = "%z. H (?x,z) " in subst_context)
   247 apply (rule_tac t = "%z. H (?x,z) " in subst_context)
   248 apply (subgoal_tac "ALL y : r-``{x}. ALL z. <y,z>:f <-> <y,z>:g")
   248 apply (subgoal_tac "\<forall>y\<in>r-``{x}. \<forall>z. <y,z>:f <-> <y,z>:g")
   249  apply (blast dest: transD)
   249  apply (blast dest: transD)
   250 apply (simp add: apply_iff)
   250 apply (simp add: apply_iff)
   251 apply (blast dest: transD intro: sym)
   251 apply (blast dest: transD intro: sym)
   252 done
   252 done
   253 
   253 
   281 by (simp add: the_recfun_eq)
   281 by (simp add: the_recfun_eq)
   282 
   282 
   283 lemma unfold_the_recfun:
   283 lemma unfold_the_recfun:
   284      "[| wf(r);  trans(r) |] ==> is_recfun(r, a, H, the_recfun(r,a,H))"
   284      "[| wf(r);  trans(r) |] ==> is_recfun(r, a, H, the_recfun(r,a,H))"
   285 apply (rule_tac a=a in wf_induct, assumption)
   285 apply (rule_tac a=a in wf_induct, assumption)
   286 apply (rename_tac a1) 
   286 apply (rename_tac a1)
   287 apply (rule_tac f = "lam y: r-``{a1}. wftrec (r,y,H)" in is_the_recfun)
   287 apply (rule_tac f = "\<lambda>y\<in>r-``{a1}. wftrec (r,y,H)" in is_the_recfun)
   288   apply typecheck
   288   apply typecheck
   289 apply (unfold is_recfun_def wftrec_def)
   289 apply (unfold is_recfun_def wftrec_def)
   290   --{*Applying the substitution: must keep the quantified assumption!*}
   290   --{*Applying the substitution: must keep the quantified assumption!*}
   291 apply (rule lam_cong [OF refl]) 
   291 apply (rule lam_cong [OF refl])
   292 apply (drule underD) 
   292 apply (drule underD)
   293 apply (fold is_recfun_def)
   293 apply (fold is_recfun_def)
   294 apply (rule_tac t = "%z. H(?x,z)" in subst_context)
   294 apply (rule_tac t = "%z. H(?x,z)" in subst_context)
   295 apply (rule fun_extension)
   295 apply (rule fun_extension)
   296   apply (blast intro: is_recfun_type)
   296   apply (blast intro: is_recfun_type)
   297  apply (rule lam_type [THEN restrict_type2])
   297  apply (rule lam_type [THEN restrict_type2])
   298   apply blast
   298   apply blast
   299  apply (blast dest: transD)
   299  apply (blast dest: transD)
   300 apply (frule spec [THEN mp], assumption)
   300 apply (frule spec [THEN mp], assumption)
   301 apply (subgoal_tac "<xa,a1> : r")
   301 apply (subgoal_tac "<xa,a1> \<in> r")
   302  apply (drule_tac x1 = xa in spec [THEN mp], assumption)
   302  apply (drule_tac x1 = xa in spec [THEN mp], assumption)
   303 apply (simp add: vimage_singleton_iff 
   303 apply (simp add: vimage_singleton_iff
   304                  apply_recfun is_recfun_cut)
   304                  apply_recfun is_recfun_cut)
   305 apply (blast dest: transD)
   305 apply (blast dest: transD)
   306 done
   306 done
   307 
   307 
   308 
   308 
   314 by (blast intro: is_recfun_cut unfold_the_recfun)
   314 by (blast intro: is_recfun_cut unfold_the_recfun)
   315 
   315 
   316 (*NOT SUITABLE FOR REWRITING: it is recursive!*)
   316 (*NOT SUITABLE FOR REWRITING: it is recursive!*)
   317 lemma wftrec:
   317 lemma wftrec:
   318     "[| wf(r);  trans(r) |] ==>
   318     "[| wf(r);  trans(r) |] ==>
   319           wftrec(r,a,H) = H(a, lam x: r-``{a}. wftrec(r,x,H))"
   319           wftrec(r,a,H) = H(a, \<lambda>x\<in>r-``{a}. wftrec(r,x,H))"
   320 apply (unfold wftrec_def)
   320 apply (unfold wftrec_def)
   321 apply (subst unfold_the_recfun [unfolded is_recfun_def])
   321 apply (subst unfold_the_recfun [unfolded is_recfun_def])
   322 apply (simp_all add: vimage_singleton_iff [THEN iff_sym] the_recfun_cut)
   322 apply (simp_all add: vimage_singleton_iff [THEN iff_sym] the_recfun_cut)
   323 done
   323 done
   324 
   324 
   325 
   325 
   326 subsubsection{*Removal of the Premise @{term "trans(r)"}*}
   326 subsubsection{*Removal of the Premise @{term "trans(r)"}*}
   327 
   327 
   328 (*NOT SUITABLE FOR REWRITING: it is recursive!*)
   328 (*NOT SUITABLE FOR REWRITING: it is recursive!*)
   329 lemma wfrec:
   329 lemma wfrec:
   330     "wf(r) ==> wfrec(r,a,H) = H(a, lam x:r-``{a}. wfrec(r,x,H))"
   330     "wf(r) ==> wfrec(r,a,H) = H(a, \<lambda>x\<in>r-``{a}. wfrec(r,x,H))"
   331 apply (unfold wfrec_def) 
   331 apply (unfold wfrec_def)
   332 apply (erule wf_trancl [THEN wftrec, THEN ssubst])
   332 apply (erule wf_trancl [THEN wftrec, THEN ssubst])
   333  apply (rule trans_trancl)
   333  apply (rule trans_trancl)
   334 apply (rule vimage_pair_mono [THEN restrict_lam_eq, THEN subst_context])
   334 apply (rule vimage_pair_mono [THEN restrict_lam_eq, THEN subst_context])
   335  apply (erule r_into_trancl)
   335  apply (erule r_into_trancl)
   336 apply (rule subset_refl)
   336 apply (rule subset_refl)
   337 done
   337 done
   338 
   338 
   339 (*This form avoids giant explosions in proofs.  NOTE USE OF == *)
   339 (*This form avoids giant explosions in proofs.  NOTE USE OF == *)
   340 lemma def_wfrec:
   340 lemma def_wfrec:
   341     "[| !!x. h(x)==wfrec(r,x,H);  wf(r) |] ==>
   341     "[| !!x. h(x)==wfrec(r,x,H);  wf(r) |] ==>
   342      h(a) = H(a, lam x: r-``{a}. h(x))"
   342      h(a) = H(a, \<lambda>x\<in>r-``{a}. h(x))"
   343 apply simp
   343 apply simp
   344 apply (elim wfrec) 
   344 apply (elim wfrec)
   345 done
   345 done
   346 
   346 
   347 lemma wfrec_type:
   347 lemma wfrec_type:
   348     "[| wf(r);  a:A;  field(r)<=A;
   348     "[| wf(r);  a:A;  field(r)<=A;
   349         !!x u. [| x: A;  u: Pi(r-``{x}, B) |] ==> H(x,u) : B(x)
   349         !!x u. [| x: A;  u: Pi(r-``{x}, B) |] ==> H(x,u) \<in> B(x)
   350      |] ==> wfrec(r,a,H) : B(a)"
   350      |] ==> wfrec(r,a,H) \<in> B(a)"
   351 apply (rule_tac a = a in wf_induct2, assumption+)
   351 apply (rule_tac a = a in wf_induct2, assumption+)
   352 apply (subst wfrec, assumption)
   352 apply (subst wfrec, assumption)
   353 apply (simp add: lam_type underD)  
   353 apply (simp add: lam_type underD)
   354 done
   354 done
   355 
   355 
   356 
   356 
   357 lemma wfrec_on:
   357 lemma wfrec_on:
   358  "[| wf[A](r);  a: A |] ==>
   358  "[| wf[A](r);  a: A |] ==>
   359          wfrec[A](r,a,H) = H(a, lam x: (r-``{a}) Int A. wfrec[A](r,x,H))"
   359          wfrec[A](r,a,H) = H(a, \<lambda>x\<in>(r-``{a}) \<inter> A. wfrec[A](r,x,H))"
   360 apply (unfold wf_on_def wfrec_on_def)
   360 apply (unfold wf_on_def wfrec_on_def)
   361 apply (erule wfrec [THEN trans])
   361 apply (erule wfrec [THEN trans])
   362 apply (simp add: vimage_Int_square cons_subset_iff)
   362 apply (simp add: vimage_Int_square cons_subset_iff)
   363 done
   363 done
   364 
   364 
   365 text{*Minimal-element characterization of well-foundedness*}
   365 text{*Minimal-element characterization of well-foundedness*}
   366 lemma wf_eq_minimal:
   366 lemma wf_eq_minimal:
   367      "wf(r) <-> (ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q))"
   367      "wf(r) <-> (\<forall>Q x. x:Q \<longrightarrow> (\<exists>z\<in>Q. \<forall>y. <y,z>:r \<longrightarrow> y\<notin>Q))"
   368 by (unfold wf_def, blast)
   368 by (unfold wf_def, blast)
   369 
   369 
   370 end
   370 end