author | paulson |
Thu, 23 May 2002 17:05:21 +0200 | |
changeset 13175 | 81082cfa5618 |
parent 13165 | 31d020705aff |
child 13203 | fac77a839aa2 |
permissions | -rw-r--r-- |
13165 | 1 |
(* Title: ZF/WF.thy |
0 | 2 |
ID: $Id$ |
1478 | 3 |
Author: Tobias Nipkow and Lawrence C Paulson |
435 | 4 |
Copyright 1994 University of Cambridge |
0 | 5 |
|
6 |
Well-founded Recursion |
|
13165 | 7 |
|
8 |
Derived first for transitive relations, and finally for arbitrary WF relations |
|
9 |
via wf_trancl and trans_trancl. |
|
10 |
||
11 |
It is difficult to derive this general case directly, using r^+ instead of |
|
12 |
r. In is_recfun, the two occurrences of the relation must have the same |
|
13 |
form. Inserting r^+ in the_recfun or wftrec yields a recursion rule with |
|
14 |
r^+ -`` {a} instead of r-``{a}. This recursion rule is stronger in |
|
15 |
principle, but harder to use, especially to prove wfrec_eclose_eq in |
|
16 |
epsilon.ML. Expanding out the definition of wftrec in wfrec would yield |
|
17 |
a mess. |
|
0 | 18 |
*) |
19 |
||
13165 | 20 |
theory WF = Trancl + mono + equalities: |
21 |
||
22 |
constdefs |
|
23 |
wf :: "i=>o" |
|
24 |
(*r is a well-founded relation*) |
|
25 |
"wf(r) == ALL Z. Z=0 | (EX x:Z. ALL y. <y,x>:r --> ~ y:Z)" |
|
26 |
||
27 |
wf_on :: "[i,i]=>o" ("wf[_]'(_')") |
|
28 |
(*r is well-founded on A*) |
|
29 |
"wf_on(A,r) == wf(r Int A*A)" |
|
30 |
||
31 |
is_recfun :: "[i, i, [i,i]=>i, i] =>o" |
|
32 |
"is_recfun(r,a,H,f) == (f = (lam x: r-``{a}. H(x, restrict(f, r-``{x}))))" |
|
33 |
||
34 |
the_recfun :: "[i, i, [i,i]=>i] =>i" |
|
35 |
"the_recfun(r,a,H) == (THE f. is_recfun(r,a,H,f))" |
|
36 |
||
37 |
wftrec :: "[i, i, [i,i]=>i] =>i" |
|
38 |
"wftrec(r,a,H) == H(a, the_recfun(r,a,H))" |
|
39 |
||
40 |
wfrec :: "[i, i, [i,i]=>i] =>i" |
|
41 |
(*public version. Does not require r to be transitive*) |
|
42 |
"wfrec(r,a,H) == wftrec(r^+, a, %x f. H(x, restrict(f,r-``{x})))" |
|
43 |
||
44 |
wfrec_on :: "[i, i, i, [i,i]=>i] =>i" ("wfrec[_]'(_,_,_')") |
|
45 |
"wfrec[A](r,a,H) == wfrec(r Int A*A, a, H)" |
|
46 |
||
47 |
||
48 |
(*** Well-founded relations ***) |
|
49 |
||
50 |
(** Equivalences between wf and wf_on **) |
|
51 |
||
52 |
lemma wf_imp_wf_on: "wf(r) ==> wf[A](r)" |
|
53 |
apply (unfold wf_def wf_on_def, clarify) (*needed for blast's efficiency*) |
|
54 |
apply blast |
|
55 |
done |
|
56 |
||
57 |
lemma wf_on_field_imp_wf: "wf[field(r)](r) ==> wf(r)" |
|
58 |
by (unfold wf_def wf_on_def, fast) |
|
59 |
||
60 |
lemma wf_iff_wf_on_field: "wf(r) <-> wf[field(r)](r)" |
|
61 |
by (blast intro: wf_imp_wf_on wf_on_field_imp_wf) |
|
62 |
||
63 |
lemma wf_on_subset_A: "[| wf[A](r); B<=A |] ==> wf[B](r)" |
|
64 |
by (unfold wf_on_def wf_def, fast) |
|
65 |
||
66 |
lemma wf_on_subset_r: "[| wf[A](r); s<=r |] ==> wf[A](s)" |
|
67 |
by (unfold wf_on_def wf_def, fast) |
|
68 |
||
69 |
(** Introduction rules for wf_on **) |
|
70 |
||
71 |
lemma wf_onI: |
|
72 |
(*If every non-empty subset of A has an r-minimal element then wf[A](r).*) |
|
73 |
assumes prem: "!!Z u. [| Z<=A; u:Z; ALL x:Z. EX y:Z. <y,x>:r |] ==> False" |
|
74 |
shows "wf[A](r)" |
|
75 |
apply (unfold wf_on_def wf_def) |
|
76 |
apply (rule equals0I [THEN disjCI, THEN allI]) |
|
77 |
apply (rule_tac Z = "Z" in prem, blast+) |
|
78 |
done |
|
79 |
||
80 |
(*If r allows well-founded induction over A then wf[A](r) |
|
81 |
Premise is equivalent to |
|
82 |
!!B. ALL x:A. (ALL y. <y,x>: r --> y:B) --> x:B ==> A<=B *) |
|
83 |
lemma wf_onI2: |
|
84 |
assumes prem: "!!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B; y:A |] |
|
85 |
==> y:B" |
|
86 |
shows "wf[A](r)" |
|
87 |
apply (rule wf_onI) |
|
88 |
apply (rule_tac c=u in prem [THEN DiffE]) |
|
89 |
prefer 3 apply blast |
|
90 |
apply fast+ |
|
91 |
done |
|
92 |
||
93 |
||
94 |
(** Well-founded Induction **) |
|
95 |
||
96 |
(*Consider the least z in domain(r) Un {a} such that P(z) does not hold...*) |
|
97 |
lemma wf_induct: |
|
98 |
"[| wf(r); |
|
99 |
!!x.[| ALL y. <y,x>: r --> P(y) |] ==> P(x) |
|
100 |
|] ==> P(a)" |
|
101 |
apply (unfold wf_def) |
|
102 |
apply (erule_tac x = "{z:domain (r) Un {a}. ~P (z) }" in allE) |
|
103 |
apply blast |
|
104 |
done |
|
435 | 105 |
|
13165 | 106 |
(*The form of this rule is designed to match wfI*) |
107 |
lemma wf_induct2: |
|
108 |
"[| wf(r); a:A; field(r)<=A; |
|
109 |
!!x.[| x: A; ALL y. <y,x>: r --> P(y) |] ==> P(x) |] |
|
110 |
==> P(a)" |
|
111 |
apply (erule_tac P="a:A" in rev_mp) |
|
112 |
apply (erule_tac a=a in wf_induct, blast) |
|
113 |
done |
|
114 |
||
115 |
lemma field_Int_square: "field(r Int A*A) <= A" |
|
116 |
by blast |
|
117 |
||
118 |
lemma wf_on_induct: |
|
119 |
"[| wf[A](r); a:A; |
|
120 |
!!x.[| x: A; ALL y:A. <y,x>: r --> P(y) |] ==> P(x) |
|
121 |
|] ==> P(a)" |
|
122 |
apply (unfold wf_on_def) |
|
123 |
apply (erule wf_induct2, assumption) |
|
124 |
apply (rule field_Int_square, blast) |
|
125 |
done |
|
126 |
||
127 |
(*If r allows well-founded induction then wf(r)*) |
|
128 |
lemma wfI: |
|
129 |
"[| field(r)<=A; |
|
130 |
!!y B. [| ALL x:A. (ALL y:A. <y,x>:r --> y:B) --> x:B; y:A|] |
|
131 |
==> y:B |] |
|
132 |
==> wf(r)" |
|
133 |
apply (rule wf_on_subset_A [THEN wf_on_field_imp_wf]) |
|
134 |
apply (rule wf_onI2) |
|
135 |
prefer 2 apply blast |
|
136 |
apply blast |
|
137 |
done |
|
138 |
||
139 |
||
140 |
(*** Properties of well-founded relations ***) |
|
141 |
||
142 |
lemma wf_not_refl: "wf(r) ==> <a,a> ~: r" |
|
143 |
by (erule_tac a=a in wf_induct, blast) |
|
144 |
||
145 |
lemma wf_not_sym [rule_format]: "wf(r) ==> ALL x. <a,x>:r --> <x,a> ~: r" |
|
146 |
by (erule_tac a=a in wf_induct, blast) |
|
147 |
||
148 |
(* [| wf(r); <a,x> : r; ~P ==> <x,a> : r |] ==> P *) |
|
149 |
lemmas wf_asym = wf_not_sym [THEN swap, standard] |
|
150 |
||
151 |
lemma wf_on_not_refl: "[| wf[A](r); a: A |] ==> <a,a> ~: r" |
|
152 |
apply (erule_tac a=a in wf_on_induct, assumption) |
|
153 |
apply blast |
|
154 |
done |
|
0 | 155 |
|
13165 | 156 |
lemma wf_on_not_sym [rule_format]: |
157 |
"[| wf[A](r); a:A |] ==> ALL b:A. <a,b>:r --> <b,a>~:r" |
|
158 |
apply (erule_tac a=a in wf_on_induct, assumption) |
|
159 |
apply blast |
|
160 |
done |
|
161 |
||
162 |
lemma wf_on_asym: |
|
163 |
"[| wf[A](r); ~Z ==> <a,b> : r; |
|
164 |
<b,a> ~: r ==> Z; ~Z ==> a : A; ~Z ==> b : A |] ==> Z" |
|
165 |
by (blast dest: wf_on_not_sym); |
|
166 |
||
167 |
||
168 |
(*Needed to prove well_ordI. Could also reason that wf[A](r) means |
|
169 |
wf(r Int A*A); thus wf( (r Int A*A)^+ ) and use wf_not_refl *) |
|
170 |
lemma wf_on_chain3: |
|
171 |
"[| wf[A](r); <a,b>:r; <b,c>:r; <c,a>:r; a:A; b:A; c:A |] ==> P" |
|
172 |
apply (subgoal_tac "ALL y:A. ALL z:A. <a,y>:r --> <y,z>:r --> <z,a>:r --> P", |
|
173 |
blast) |
|
174 |
apply (erule_tac a=a in wf_on_induct, assumption) |
|
175 |
apply blast |
|
176 |
done |
|
177 |
||
178 |
||
179 |
||
180 |
||
181 |
(*transitive closure of a WF relation is WF provided A is downwards closed*) |
|
182 |
lemma wf_on_trancl: |
|
183 |
"[| wf[A](r); r-``A <= A |] ==> wf[A](r^+)" |
|
184 |
apply (rule wf_onI2) |
|
185 |
apply (frule bspec [THEN mp], assumption+) |
|
186 |
apply (erule_tac a = "y" in wf_on_induct, assumption) |
|
187 |
apply (blast elim: tranclE, blast) |
|
188 |
done |
|
189 |
||
190 |
lemma wf_trancl: "wf(r) ==> wf(r^+)" |
|
191 |
apply (simp add: wf_iff_wf_on_field) |
|
192 |
apply (rule wf_on_subset_A) |
|
193 |
apply (erule wf_on_trancl) |
|
194 |
apply blast |
|
195 |
apply (rule trancl_type [THEN field_rel_subset]) |
|
196 |
done |
|
197 |
||
198 |
||
199 |
||
200 |
(** r-``{a} is the set of everything under a in r **) |
|
201 |
||
202 |
lemmas underI = vimage_singleton_iff [THEN iffD2, standard] |
|
203 |
lemmas underD = vimage_singleton_iff [THEN iffD1, standard] |
|
204 |
||
205 |
(** is_recfun **) |
|
0 | 206 |
|
13165 | 207 |
lemma is_recfun_type: "is_recfun(r,a,H,f) ==> f: r-``{a} -> range(f)" |
208 |
apply (unfold is_recfun_def) |
|
209 |
apply (erule ssubst) |
|
210 |
apply (rule lamI [THEN rangeI, THEN lam_type], assumption) |
|
211 |
done |
|
212 |
||
213 |
lemma apply_recfun: |
|
214 |
"[| is_recfun(r,a,H,f); <x,a>:r |] ==> f`x = H(x, restrict(f,r-``{x}))" |
|
215 |
apply (unfold is_recfun_def) |
|
13175
81082cfa5618
new definition of "apply" and new simprule "beta_if"
paulson
parents:
13165
diff
changeset
|
216 |
txt{*replace f only on the left-hand side*} |
81082cfa5618
new definition of "apply" and new simprule "beta_if"
paulson
parents:
13165
diff
changeset
|
217 |
apply (erule_tac P = "%x.?t(x) = ?u" in ssubst) |
81082cfa5618
new definition of "apply" and new simprule "beta_if"
paulson
parents:
13165
diff
changeset
|
218 |
apply (simp add: underI); |
13165 | 219 |
done |
220 |
||
221 |
lemma is_recfun_equal [rule_format]: |
|
222 |
"[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,b,H,g) |] |
|
223 |
==> <x,a>:r --> <x,b>:r --> f`x=g`x" |
|
224 |
apply (frule_tac f = "f" in is_recfun_type) |
|
225 |
apply (frule_tac f = "g" in is_recfun_type) |
|
226 |
apply (simp add: is_recfun_def) |
|
227 |
apply (erule_tac a=x in wf_induct) |
|
228 |
apply (intro impI) |
|
229 |
apply (elim ssubst) |
|
230 |
apply (simp (no_asm_simp) add: vimage_singleton_iff restrict_def) |
|
231 |
apply (rule_tac t = "%z. H (?x,z) " in subst_context) |
|
232 |
apply (subgoal_tac "ALL y : r-``{x}. ALL z. <y,z>:f <-> <y,z>:g") |
|
233 |
apply (blast dest: transD) |
|
234 |
apply (simp add: apply_iff) |
|
235 |
apply (blast dest: transD intro: sym) |
|
236 |
done |
|
237 |
||
238 |
lemma is_recfun_cut: |
|
239 |
"[| wf(r); trans(r); |
|
240 |
is_recfun(r,a,H,f); is_recfun(r,b,H,g); <b,a>:r |] |
|
241 |
==> restrict(f, r-``{b}) = g" |
|
242 |
apply (frule_tac f = "f" in is_recfun_type) |
|
243 |
apply (rule fun_extension) |
|
244 |
apply (blast dest: transD intro: restrict_type2) |
|
245 |
apply (erule is_recfun_type, simp) |
|
246 |
apply (blast dest: transD intro: is_recfun_equal) |
|
247 |
done |
|
248 |
||
249 |
(*** Main Existence Lemma ***) |
|
435 | 250 |
|
13165 | 251 |
lemma is_recfun_functional: |
252 |
"[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g) |] ==> f=g" |
|
253 |
by (blast intro: fun_extension is_recfun_type is_recfun_equal) |
|
254 |
||
255 |
(*If some f satisfies is_recfun(r,a,H,-) then so does the_recfun(r,a,H) *) |
|
256 |
lemma is_the_recfun: |
|
257 |
"[| is_recfun(r,a,H,f); wf(r); trans(r) |] |
|
258 |
==> is_recfun(r, a, H, the_recfun(r,a,H))" |
|
259 |
apply (unfold the_recfun_def) |
|
260 |
apply (rule ex1I [THEN theI], assumption) |
|
261 |
apply (blast intro: is_recfun_functional) |
|
262 |
done |
|
263 |
||
264 |
lemma unfold_the_recfun: |
|
265 |
"[| wf(r); trans(r) |] ==> is_recfun(r, a, H, the_recfun(r,a,H))" |
|
266 |
apply (rule_tac a=a in wf_induct, assumption) |
|
267 |
apply (rename_tac a1) |
|
268 |
apply (rule_tac f = "lam y: r-``{a1}. wftrec (r,y,H)" in is_the_recfun) |
|
269 |
apply typecheck |
|
270 |
apply (unfold is_recfun_def wftrec_def) |
|
271 |
(*Applying the substitution: must keep the quantified assumption!!*) |
|
272 |
apply (rule lam_cong [OF refl]) |
|
273 |
apply (drule underD) |
|
274 |
apply (fold is_recfun_def) |
|
275 |
apply (rule_tac t = "%z. H(?x,z)" in subst_context) |
|
276 |
apply (rule fun_extension) |
|
277 |
apply (blast intro: is_recfun_type) |
|
278 |
apply (rule lam_type [THEN restrict_type2]) |
|
279 |
apply blast |
|
280 |
apply (blast dest: transD) |
|
281 |
apply (frule spec [THEN mp], assumption) |
|
282 |
apply (subgoal_tac "<xa,a1> : r") |
|
283 |
apply (drule_tac x1 = "xa" in spec [THEN mp], assumption) |
|
13175
81082cfa5618
new definition of "apply" and new simprule "beta_if"
paulson
parents:
13165
diff
changeset
|
284 |
apply (simp add: vimage_singleton_iff |
13165 | 285 |
apply_recfun is_recfun_cut) |
286 |
apply (blast dest: transD) |
|
287 |
done |
|
288 |
||
289 |
||
290 |
(*** Unfolding wftrec ***) |
|
291 |
||
292 |
lemma the_recfun_cut: |
|
293 |
"[| wf(r); trans(r); <b,a>:r |] |
|
294 |
==> restrict(the_recfun(r,a,H), r-``{b}) = the_recfun(r,b,H)" |
|
295 |
by (blast intro: is_recfun_cut unfold_the_recfun); |
|
0 | 296 |
|
13165 | 297 |
(*NOT SUITABLE FOR REWRITING: it is recursive!*) |
298 |
lemma wftrec: |
|
299 |
"[| wf(r); trans(r) |] ==> |
|
300 |
wftrec(r,a,H) = H(a, lam x: r-``{a}. wftrec(r,x,H))" |
|
301 |
apply (unfold wftrec_def) |
|
302 |
apply (subst unfold_the_recfun [unfolded is_recfun_def]) |
|
303 |
apply (simp_all add: vimage_singleton_iff [THEN iff_sym] the_recfun_cut) |
|
304 |
done |
|
305 |
||
306 |
(** Removal of the premise trans(r) **) |
|
307 |
||
308 |
(*NOT SUITABLE FOR REWRITING: it is recursive!*) |
|
309 |
lemma wfrec: |
|
310 |
"wf(r) ==> wfrec(r,a,H) = H(a, lam x:r-``{a}. wfrec(r,x,H))" |
|
311 |
apply (unfold wfrec_def) |
|
312 |
apply (erule wf_trancl [THEN wftrec, THEN ssubst]) |
|
313 |
apply (rule trans_trancl) |
|
314 |
apply (rule vimage_pair_mono [THEN restrict_lam_eq, THEN subst_context]) |
|
315 |
apply (erule r_into_trancl) |
|
316 |
apply (rule subset_refl) |
|
317 |
done |
|
0 | 318 |
|
13165 | 319 |
(*This form avoids giant explosions in proofs. NOTE USE OF == *) |
320 |
lemma def_wfrec: |
|
321 |
"[| !!x. h(x)==wfrec(r,x,H); wf(r) |] ==> |
|
322 |
h(a) = H(a, lam x: r-``{a}. h(x))" |
|
323 |
apply simp |
|
324 |
apply (elim wfrec) |
|
325 |
done |
|
326 |
||
327 |
lemma wfrec_type: |
|
328 |
"[| wf(r); a:A; field(r)<=A; |
|
329 |
!!x u. [| x: A; u: Pi(r-``{x}, B) |] ==> H(x,u) : B(x) |
|
330 |
|] ==> wfrec(r,a,H) : B(a)" |
|
331 |
apply (rule_tac a = "a" in wf_induct2, assumption+) |
|
332 |
apply (subst wfrec, assumption) |
|
333 |
apply (simp add: lam_type underD) |
|
334 |
done |
|
335 |
||
336 |
||
337 |
lemma wfrec_on: |
|
338 |
"[| wf[A](r); a: A |] ==> |
|
339 |
wfrec[A](r,a,H) = H(a, lam x: (r-``{a}) Int A. wfrec[A](r,x,H))" |
|
340 |
apply (unfold wf_on_def wfrec_on_def) |
|
341 |
apply (erule wfrec [THEN trans]) |
|
342 |
apply (simp add: vimage_Int_square cons_subset_iff) |
|
343 |
done |
|
0 | 344 |
|
13165 | 345 |
(*Minimal-element characterization of well-foundedness*) |
346 |
lemma wf_eq_minimal: |
|
347 |
"wf(r) <-> (ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q))" |
|
348 |
apply (unfold wf_def, blast) |
|
349 |
done |
|
350 |
||
351 |
ML |
|
352 |
{* |
|
353 |
val wf_def = thm "wf_def"; |
|
354 |
val wf_on_def = thm "wf_on_def"; |
|
0 | 355 |
|
13165 | 356 |
val wf_imp_wf_on = thm "wf_imp_wf_on"; |
357 |
val wf_on_field_imp_wf = thm "wf_on_field_imp_wf"; |
|
358 |
val wf_iff_wf_on_field = thm "wf_iff_wf_on_field"; |
|
359 |
val wf_on_subset_A = thm "wf_on_subset_A"; |
|
360 |
val wf_on_subset_r = thm "wf_on_subset_r"; |
|
361 |
val wf_onI = thm "wf_onI"; |
|
362 |
val wf_onI2 = thm "wf_onI2"; |
|
363 |
val wf_induct = thm "wf_induct"; |
|
364 |
val wf_induct2 = thm "wf_induct2"; |
|
365 |
val field_Int_square = thm "field_Int_square"; |
|
366 |
val wf_on_induct = thm "wf_on_induct"; |
|
367 |
val wfI = thm "wfI"; |
|
368 |
val wf_not_refl = thm "wf_not_refl"; |
|
369 |
val wf_not_sym = thm "wf_not_sym"; |
|
370 |
val wf_asym = thm "wf_asym"; |
|
371 |
val wf_on_not_refl = thm "wf_on_not_refl"; |
|
372 |
val wf_on_not_sym = thm "wf_on_not_sym"; |
|
373 |
val wf_on_asym = thm "wf_on_asym"; |
|
374 |
val wf_on_chain3 = thm "wf_on_chain3"; |
|
375 |
val wf_on_trancl = thm "wf_on_trancl"; |
|
376 |
val wf_trancl = thm "wf_trancl"; |
|
377 |
val underI = thm "underI"; |
|
378 |
val underD = thm "underD"; |
|
379 |
val is_recfun_type = thm "is_recfun_type"; |
|
380 |
val apply_recfun = thm "apply_recfun"; |
|
381 |
val is_recfun_equal = thm "is_recfun_equal"; |
|
382 |
val is_recfun_cut = thm "is_recfun_cut"; |
|
383 |
val is_recfun_functional = thm "is_recfun_functional"; |
|
384 |
val is_the_recfun = thm "is_the_recfun"; |
|
385 |
val unfold_the_recfun = thm "unfold_the_recfun"; |
|
386 |
val the_recfun_cut = thm "the_recfun_cut"; |
|
387 |
val wftrec = thm "wftrec"; |
|
388 |
val wfrec = thm "wfrec"; |
|
389 |
val def_wfrec = thm "def_wfrec"; |
|
390 |
val wfrec_type = thm "wfrec_type"; |
|
391 |
val wfrec_on = thm "wfrec_on"; |
|
392 |
val wf_eq_minimal = thm "wf_eq_minimal"; |
|
393 |
*} |
|
435 | 394 |
|
0 | 395 |
end |