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)
|
|
216 |
apply (erule_tac P = "%x.?t (x) = (?u::i) " in ssubst)
|
|
217 |
apply (erule underI [THEN beta])
|
|
218 |
done
|
|
219 |
|
|
220 |
lemma is_recfun_equal [rule_format]:
|
|
221 |
"[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,b,H,g) |]
|
|
222 |
==> <x,a>:r --> <x,b>:r --> f`x=g`x"
|
|
223 |
apply (frule_tac f = "f" in is_recfun_type)
|
|
224 |
apply (frule_tac f = "g" in is_recfun_type)
|
|
225 |
apply (simp add: is_recfun_def)
|
|
226 |
apply (erule_tac a=x in wf_induct)
|
|
227 |
apply (intro impI)
|
|
228 |
apply (elim ssubst)
|
|
229 |
apply (simp (no_asm_simp) add: vimage_singleton_iff restrict_def)
|
|
230 |
apply (rule_tac t = "%z. H (?x,z) " in subst_context)
|
|
231 |
apply (subgoal_tac "ALL y : r-``{x}. ALL z. <y,z>:f <-> <y,z>:g")
|
|
232 |
apply (blast dest: transD)
|
|
233 |
apply (simp add: apply_iff)
|
|
234 |
apply (blast dest: transD intro: sym)
|
|
235 |
done
|
|
236 |
|
|
237 |
lemma is_recfun_cut:
|
|
238 |
"[| wf(r); trans(r);
|
|
239 |
is_recfun(r,a,H,f); is_recfun(r,b,H,g); <b,a>:r |]
|
|
240 |
==> restrict(f, r-``{b}) = g"
|
|
241 |
apply (frule_tac f = "f" in is_recfun_type)
|
|
242 |
apply (rule fun_extension)
|
|
243 |
apply (blast dest: transD intro: restrict_type2)
|
|
244 |
apply (erule is_recfun_type, simp)
|
|
245 |
apply (blast dest: transD intro: is_recfun_equal)
|
|
246 |
done
|
|
247 |
|
|
248 |
(*** Main Existence Lemma ***)
|
435
|
249 |
|
13165
|
250 |
lemma is_recfun_functional:
|
|
251 |
"[| wf(r); trans(r); is_recfun(r,a,H,f); is_recfun(r,a,H,g) |] ==> f=g"
|
|
252 |
by (blast intro: fun_extension is_recfun_type is_recfun_equal)
|
|
253 |
|
|
254 |
(*If some f satisfies is_recfun(r,a,H,-) then so does the_recfun(r,a,H) *)
|
|
255 |
lemma is_the_recfun:
|
|
256 |
"[| is_recfun(r,a,H,f); wf(r); trans(r) |]
|
|
257 |
==> is_recfun(r, a, H, the_recfun(r,a,H))"
|
|
258 |
apply (unfold the_recfun_def)
|
|
259 |
apply (rule ex1I [THEN theI], assumption)
|
|
260 |
apply (blast intro: is_recfun_functional)
|
|
261 |
done
|
|
262 |
|
|
263 |
lemma unfold_the_recfun:
|
|
264 |
"[| wf(r); trans(r) |] ==> is_recfun(r, a, H, the_recfun(r,a,H))"
|
|
265 |
apply (rule_tac a=a in wf_induct, assumption)
|
|
266 |
apply (rename_tac a1)
|
|
267 |
apply (rule_tac f = "lam y: r-``{a1}. wftrec (r,y,H)" in is_the_recfun)
|
|
268 |
apply typecheck
|
|
269 |
apply (unfold is_recfun_def wftrec_def)
|
|
270 |
(*Applying the substitution: must keep the quantified assumption!!*)
|
|
271 |
apply (rule lam_cong [OF refl])
|
|
272 |
apply (drule underD)
|
|
273 |
apply (fold is_recfun_def)
|
|
274 |
apply (rule_tac t = "%z. H(?x,z)" in subst_context)
|
|
275 |
apply (rule fun_extension)
|
|
276 |
apply (blast intro: is_recfun_type)
|
|
277 |
apply (rule lam_type [THEN restrict_type2])
|
|
278 |
apply blast
|
|
279 |
apply (blast dest: transD)
|
|
280 |
apply (frule spec [THEN mp], assumption)
|
|
281 |
apply (subgoal_tac "<xa,a1> : r")
|
|
282 |
apply (drule_tac x1 = "xa" in spec [THEN mp], assumption)
|
|
283 |
apply (simp add: vimage_singleton_iff underI [THEN beta]
|
|
284 |
apply_recfun is_recfun_cut)
|
|
285 |
apply (blast dest: transD)
|
|
286 |
done
|
|
287 |
|
|
288 |
|
|
289 |
(*** Unfolding wftrec ***)
|
|
290 |
|
|
291 |
lemma the_recfun_cut:
|
|
292 |
"[| wf(r); trans(r); <b,a>:r |]
|
|
293 |
==> restrict(the_recfun(r,a,H), r-``{b}) = the_recfun(r,b,H)"
|
|
294 |
by (blast intro: is_recfun_cut unfold_the_recfun);
|
0
|
295 |
|
13165
|
296 |
(*NOT SUITABLE FOR REWRITING: it is recursive!*)
|
|
297 |
lemma wftrec:
|
|
298 |
"[| wf(r); trans(r) |] ==>
|
|
299 |
wftrec(r,a,H) = H(a, lam x: r-``{a}. wftrec(r,x,H))"
|
|
300 |
apply (unfold wftrec_def)
|
|
301 |
apply (subst unfold_the_recfun [unfolded is_recfun_def])
|
|
302 |
apply (simp_all add: vimage_singleton_iff [THEN iff_sym] the_recfun_cut)
|
|
303 |
done
|
|
304 |
|
|
305 |
(** Removal of the premise trans(r) **)
|
|
306 |
|
|
307 |
(*NOT SUITABLE FOR REWRITING: it is recursive!*)
|
|
308 |
lemma wfrec:
|
|
309 |
"wf(r) ==> wfrec(r,a,H) = H(a, lam x:r-``{a}. wfrec(r,x,H))"
|
|
310 |
apply (unfold wfrec_def)
|
|
311 |
apply (erule wf_trancl [THEN wftrec, THEN ssubst])
|
|
312 |
apply (rule trans_trancl)
|
|
313 |
apply (rule vimage_pair_mono [THEN restrict_lam_eq, THEN subst_context])
|
|
314 |
apply (erule r_into_trancl)
|
|
315 |
apply (rule subset_refl)
|
|
316 |
done
|
0
|
317 |
|
13165
|
318 |
(*This form avoids giant explosions in proofs. NOTE USE OF == *)
|
|
319 |
lemma def_wfrec:
|
|
320 |
"[| !!x. h(x)==wfrec(r,x,H); wf(r) |] ==>
|
|
321 |
h(a) = H(a, lam x: r-``{a}. h(x))"
|
|
322 |
apply simp
|
|
323 |
apply (elim wfrec)
|
|
324 |
done
|
|
325 |
|
|
326 |
lemma wfrec_type:
|
|
327 |
"[| wf(r); a:A; field(r)<=A;
|
|
328 |
!!x u. [| x: A; u: Pi(r-``{x}, B) |] ==> H(x,u) : B(x)
|
|
329 |
|] ==> wfrec(r,a,H) : B(a)"
|
|
330 |
apply (rule_tac a = "a" in wf_induct2, assumption+)
|
|
331 |
apply (subst wfrec, assumption)
|
|
332 |
apply (simp add: lam_type underD)
|
|
333 |
done
|
|
334 |
|
|
335 |
|
|
336 |
lemma wfrec_on:
|
|
337 |
"[| wf[A](r); a: A |] ==>
|
|
338 |
wfrec[A](r,a,H) = H(a, lam x: (r-``{a}) Int A. wfrec[A](r,x,H))"
|
|
339 |
apply (unfold wf_on_def wfrec_on_def)
|
|
340 |
apply (erule wfrec [THEN trans])
|
|
341 |
apply (simp add: vimage_Int_square cons_subset_iff)
|
|
342 |
done
|
0
|
343 |
|
13165
|
344 |
(*Minimal-element characterization of well-foundedness*)
|
|
345 |
lemma wf_eq_minimal:
|
|
346 |
"wf(r) <-> (ALL Q x. x:Q --> (EX z:Q. ALL y. <y,z>:r --> y~:Q))"
|
|
347 |
apply (unfold wf_def, blast)
|
|
348 |
done
|
|
349 |
|
|
350 |
ML
|
|
351 |
{*
|
|
352 |
val wf_def = thm "wf_def";
|
|
353 |
val wf_on_def = thm "wf_on_def";
|
0
|
354 |
|
13165
|
355 |
val wf_imp_wf_on = thm "wf_imp_wf_on";
|
|
356 |
val wf_on_field_imp_wf = thm "wf_on_field_imp_wf";
|
|
357 |
val wf_iff_wf_on_field = thm "wf_iff_wf_on_field";
|
|
358 |
val wf_on_subset_A = thm "wf_on_subset_A";
|
|
359 |
val wf_on_subset_r = thm "wf_on_subset_r";
|
|
360 |
val wf_onI = thm "wf_onI";
|
|
361 |
val wf_onI2 = thm "wf_onI2";
|
|
362 |
val wf_induct = thm "wf_induct";
|
|
363 |
val wf_induct2 = thm "wf_induct2";
|
|
364 |
val field_Int_square = thm "field_Int_square";
|
|
365 |
val wf_on_induct = thm "wf_on_induct";
|
|
366 |
val wfI = thm "wfI";
|
|
367 |
val wf_not_refl = thm "wf_not_refl";
|
|
368 |
val wf_not_sym = thm "wf_not_sym";
|
|
369 |
val wf_asym = thm "wf_asym";
|
|
370 |
val wf_on_not_refl = thm "wf_on_not_refl";
|
|
371 |
val wf_on_not_sym = thm "wf_on_not_sym";
|
|
372 |
val wf_on_asym = thm "wf_on_asym";
|
|
373 |
val wf_on_chain3 = thm "wf_on_chain3";
|
|
374 |
val wf_on_trancl = thm "wf_on_trancl";
|
|
375 |
val wf_trancl = thm "wf_trancl";
|
|
376 |
val underI = thm "underI";
|
|
377 |
val underD = thm "underD";
|
|
378 |
val is_recfun_type = thm "is_recfun_type";
|
|
379 |
val apply_recfun = thm "apply_recfun";
|
|
380 |
val is_recfun_equal = thm "is_recfun_equal";
|
|
381 |
val is_recfun_cut = thm "is_recfun_cut";
|
|
382 |
val is_recfun_functional = thm "is_recfun_functional";
|
|
383 |
val is_the_recfun = thm "is_the_recfun";
|
|
384 |
val unfold_the_recfun = thm "unfold_the_recfun";
|
|
385 |
val the_recfun_cut = thm "the_recfun_cut";
|
|
386 |
val wftrec = thm "wftrec";
|
|
387 |
val wfrec = thm "wfrec";
|
|
388 |
val def_wfrec = thm "def_wfrec";
|
|
389 |
val wfrec_type = thm "wfrec_type";
|
|
390 |
val wfrec_on = thm "wfrec_on";
|
|
391 |
val wf_eq_minimal = thm "wf_eq_minimal";
|
|
392 |
*}
|
435
|
393 |
|
0
|
394 |
end
|