author | paulson |
Fri, 05 Jul 2002 18:33:50 +0200 | |
changeset 13306 | 6eebcddee32b |
parent 13299 | 3a932abf97e8 |
child 13319 | 23de7b3af453 |
permissions | -rw-r--r-- |
13306 | 1 |
header{*Relativized Well-Founded Recursion*} |
2 |
||
13223 | 3 |
theory WFrec = Wellorderings: |
4 |
||
5 |
||
13254 | 6 |
(*Many of these might be useful in WF.thy*) |
13223 | 7 |
|
13269 | 8 |
lemma apply_recfun2: |
9 |
"[| is_recfun(r,a,H,f); <x,i>:f |] ==> i = H(x, restrict(f,r-``{x}))" |
|
10 |
apply (frule apply_recfun) |
|
11 |
apply (blast dest: is_recfun_type fun_is_rel) |
|
12 |
apply (simp add: function_apply_equality [OF _ is_recfun_imp_function]) |
|
13223 | 13 |
done |
14 |
||
15 |
text{*Expresses @{text is_recfun} as a recursion equation*} |
|
16 |
lemma is_recfun_iff_equation: |
|
17 |
"is_recfun(r,a,H,f) <-> |
|
18 |
f \<in> r -`` {a} \<rightarrow> range(f) & |
|
19 |
(\<forall>x \<in> r-``{a}. f`x = H(x, restrict(f, r-``{x})))" |
|
20 |
apply (rule iffI) |
|
21 |
apply (simp add: is_recfun_type apply_recfun Ball_def vimage_singleton_iff, |
|
22 |
clarify) |
|
23 |
apply (simp add: is_recfun_def) |
|
24 |
apply (rule fun_extension) |
|
25 |
apply assumption |
|
26 |
apply (fast intro: lam_type, simp) |
|
27 |
done |
|
28 |
||
13245 | 29 |
lemma is_recfun_imp_in_r: "[|is_recfun(r,a,H,f); \<langle>x,i\<rangle> \<in> f|] ==> \<langle>x, a\<rangle> \<in> r" |
13269 | 30 |
by (blast dest: is_recfun_type fun_is_rel) |
13245 | 31 |
|
13254 | 32 |
lemma trans_Int_eq: |
33 |
"[| trans(r); <y,x> \<in> r |] ==> r -`` {x} \<inter> r -`` {y} = r -`` {y}" |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
34 |
by (blast intro: transD) |
13223 | 35 |
|
13254 | 36 |
lemma is_recfun_restrict_idem: |
37 |
"is_recfun(r,a,H,f) ==> restrict(f, r -`` {a}) = f" |
|
38 |
apply (drule is_recfun_type) |
|
39 |
apply (auto simp add: Pi_iff subset_Sigma_imp_relation restrict_idem) |
|
40 |
done |
|
41 |
||
42 |
lemma is_recfun_cong_lemma: |
|
43 |
"[| is_recfun(r,a,H,f); r = r'; a = a'; f = f'; |
|
44 |
!!x g. [| <x,a'> \<in> r'; relation(g); domain(g) <= r' -``{x} |] |
|
45 |
==> H(x,g) = H'(x,g) |] |
|
46 |
==> is_recfun(r',a',H',f')" |
|
47 |
apply (simp add: is_recfun_def) |
|
48 |
apply (erule trans) |
|
49 |
apply (rule lam_cong) |
|
50 |
apply (simp_all add: vimage_singleton_iff Int_lower2) |
|
51 |
done |
|
52 |
||
53 |
text{*For @{text is_recfun} we need only pay attention to functions |
|
54 |
whose domains are initial segments of @{term r}.*} |
|
55 |
lemma is_recfun_cong: |
|
56 |
"[| r = r'; a = a'; f = f'; |
|
57 |
!!x g. [| <x,a'> \<in> r'; relation(g); domain(g) <= r' -``{x} |] |
|
58 |
==> H(x,g) = H'(x,g) |] |
|
59 |
==> is_recfun(r,a,H,f) <-> is_recfun(r',a',H',f')" |
|
60 |
apply (rule iffI) |
|
61 |
txt{*Messy: fast and blast don't work for some reason*} |
|
62 |
apply (erule is_recfun_cong_lemma, auto) |
|
63 |
apply (erule is_recfun_cong_lemma) |
|
64 |
apply (blast intro: sym)+ |
|
65 |
done |
|
13223 | 66 |
|
67 |
||
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
68 |
text{*Stated using @{term "trans(r)"} rather than |
13223 | 69 |
@{term "transitive_rel(M,A,r)"} because the latter rewrites to |
70 |
the former anyway, by @{text transitive_rel_abs}. |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
71 |
As always, theorems should be expressed in simplified form. |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
72 |
The last three M-premises are redundant because of @{term "M(r)"}, |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
73 |
but without them we'd have to undertake |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
74 |
more work to set up the induction formula.*} |
13223 | 75 |
lemma (in M_axioms) is_recfun_equal [rule_format]: |
76 |
"[|is_recfun(r,a,H,f); is_recfun(r,b,H,g); |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
77 |
wellfounded(M,r); trans(r); |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
78 |
M(f); M(g); M(r); M(x); M(a); M(b) |] |
13223 | 79 |
==> <x,a> \<in> r --> <x,b> \<in> r --> f`x=g`x" |
80 |
apply (frule_tac f="f" in is_recfun_type) |
|
81 |
apply (frule_tac f="g" in is_recfun_type) |
|
82 |
apply (simp add: is_recfun_def) |
|
13254 | 83 |
apply (erule_tac a=x in wellfounded_induct, assumption+) |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
84 |
txt{*Separation to justify the induction*} |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
85 |
apply (force intro: is_recfun_separation) |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
86 |
txt{*Now the inductive argument itself*} |
13254 | 87 |
apply clarify |
13223 | 88 |
apply (erule ssubst)+ |
89 |
apply (simp (no_asm_simp) add: vimage_singleton_iff restrict_def) |
|
90 |
apply (rename_tac x1) |
|
91 |
apply (rule_tac t="%z. H(x1,z)" in subst_context) |
|
92 |
apply (subgoal_tac "ALL y : r-``{x1}. ALL z. <y,z>:f <-> <y,z>:g") |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
93 |
apply (blast intro: transD) |
13223 | 94 |
apply (simp add: apply_iff) |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
95 |
apply (blast intro: transD sym) |
13223 | 96 |
done |
97 |
||
98 |
lemma (in M_axioms) is_recfun_cut: |
|
99 |
"[|is_recfun(r,a,H,f); is_recfun(r,b,H,g); |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
100 |
wellfounded(M,r); trans(r); |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
101 |
M(f); M(g); M(r); <b,a> \<in> r |] |
13223 | 102 |
==> restrict(f, r-``{b}) = g" |
103 |
apply (frule_tac f="f" in is_recfun_type) |
|
104 |
apply (rule fun_extension) |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
105 |
apply (blast intro: transD restrict_type2) |
13223 | 106 |
apply (erule is_recfun_type, simp) |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
107 |
apply (blast intro: is_recfun_equal transD dest: transM) |
13223 | 108 |
done |
109 |
||
110 |
lemma (in M_axioms) is_recfun_functional: |
|
111 |
"[|is_recfun(r,a,H,f); is_recfun(r,a,H,g); |
|
13268 | 112 |
wellfounded(M,r); trans(r); M(f); M(g); M(r) |] ==> f=g" |
13223 | 113 |
apply (rule fun_extension) |
114 |
apply (erule is_recfun_type)+ |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
115 |
apply (blast intro!: is_recfun_equal dest: transM) |
13254 | 116 |
done |
13223 | 117 |
|
13295 | 118 |
text{*Tells us that @{text is_recfun} can (in principle) be relativized.*} |
13223 | 119 |
lemma (in M_axioms) is_recfun_relativize: |
13254 | 120 |
"[| M(r); M(f); \<forall>x[M]. \<forall>g[M]. function(g) --> M(H(x,g)) |] |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
121 |
==> is_recfun(r,a,H,f) <-> |
13254 | 122 |
(\<forall>z[M]. z \<in> f <-> |
123 |
(\<exists>x[M]. <x,a> \<in> r & z = <x, H(x, restrict(f, r-``{x}))>))"; |
|
124 |
apply (simp add: is_recfun_def lam_def) |
|
13223 | 125 |
apply (safe intro!: equalityI) |
13254 | 126 |
apply (drule equalityD1 [THEN subsetD], assumption) |
127 |
apply (blast dest: pair_components_in_M) |
|
128 |
apply (blast elim!: equalityE dest: pair_components_in_M) |
|
129 |
apply (frule transM, assumption, rotate_tac -1) |
|
13223 | 130 |
apply simp |
131 |
apply blast |
|
13254 | 132 |
apply (subgoal_tac "is_function(M,f)") |
133 |
txt{*We use @{term "is_function"} rather than @{term "function"} because |
|
134 |
the subgoal's easier to prove with relativized quantifiers!*} |
|
135 |
prefer 2 apply (simp add: is_function_def) |
|
13223 | 136 |
apply (frule pair_components_in_M, assumption) |
13254 | 137 |
apply (simp add: is_recfun_imp_function function_restrictI) |
13223 | 138 |
done |
139 |
||
140 |
(* ideas for further weaking the H-closure premise: |
|
141 |
apply (drule spec [THEN spec]) |
|
142 |
apply (erule mp) |
|
143 |
apply (intro conjI) |
|
144 |
apply (blast dest!: pair_components_in_M) |
|
145 |
apply (blast intro!: function_restrictI dest!: pair_components_in_M) |
|
146 |
apply (blast intro!: function_restrictI dest!: pair_components_in_M) |
|
147 |
apply (simp only: subset_iff domain_iff restrict_iff vimage_iff) |
|
13269 | 148 |
apply (simp add: vimage_singleton_iff) |
13223 | 149 |
apply (intro allI impI conjI) |
150 |
apply (blast intro: transM dest!: pair_components_in_M) |
|
151 |
prefer 4;apply blast |
|
152 |
*) |
|
153 |
||
154 |
lemma (in M_axioms) is_recfun_restrict: |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
155 |
"[| wellfounded(M,r); trans(r); is_recfun(r,x,H,f); \<langle>y,x\<rangle> \<in> r; |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
156 |
M(r); M(f); |
13254 | 157 |
\<forall>x[M]. \<forall>g[M]. function(g) --> M(H(x,g)) |] |
13223 | 158 |
==> is_recfun(r, y, H, restrict(f, r -`` {y}))" |
159 |
apply (frule pair_components_in_M, assumption, clarify) |
|
13254 | 160 |
apply (simp (no_asm_simp) add: is_recfun_relativize restrict_iff |
161 |
trans_Int_eq) |
|
13223 | 162 |
apply safe |
163 |
apply (simp_all add: vimage_singleton_iff is_recfun_type [THEN apply_iff]) |
|
164 |
apply (frule_tac x=xa in pair_components_in_M, assumption) |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
165 |
apply (frule_tac x=xa in apply_recfun, blast intro: transD) |
13247 | 166 |
apply (simp add: is_recfun_type [THEN apply_iff] |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
167 |
is_recfun_imp_function function_restrictI) |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
168 |
apply (blast intro: apply_recfun dest: transD) |
13223 | 169 |
done |
170 |
||
171 |
lemma (in M_axioms) restrict_Y_lemma: |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
172 |
"[| wellfounded(M,r); trans(r); M(r); |
13254 | 173 |
\<forall>x[M]. \<forall>g[M]. function(g) --> M(H(x,g)); M(Y); |
13299 | 174 |
\<forall>b[M]. |
13223 | 175 |
b \<in> Y <-> |
13299 | 176 |
(\<exists>x[M]. <x,a1> \<in> r & |
177 |
(\<exists>y[M]. b = \<langle>x,y\<rangle> & (\<exists>g[M]. is_recfun(r,x,H,g) \<and> y = H(x,g)))); |
|
178 |
\<langle>x,a1\<rangle> \<in> r; is_recfun(r,x,H,f); M(f) |] |
|
13223 | 179 |
==> restrict(Y, r -`` {x}) = f" |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
180 |
apply (subgoal_tac "\<forall>y \<in> r-``{x}. \<forall>z. <y,z>:Y <-> <y,z>:f") |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
181 |
apply (simp (no_asm_simp) add: restrict_def) |
13254 | 182 |
apply (thin_tac "rall(M,?P)")+ --{*essential for efficiency*} |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
183 |
apply (frule is_recfun_type [THEN fun_is_rel], blast) |
13223 | 184 |
apply (frule pair_components_in_M, assumption, clarify) |
185 |
apply (rule iffI) |
|
186 |
apply (frule_tac y="<y,z>" in transM, assumption ) |
|
187 |
apply (rotate_tac -1) |
|
188 |
apply (clarsimp simp add: vimage_singleton_iff is_recfun_type [THEN apply_iff] |
|
189 |
apply_recfun is_recfun_cut) |
|
190 |
txt{*Opposite inclusion: something in f, show in Y*} |
|
13293 | 191 |
apply (frule_tac y="<y,z>" in transM, assumption) |
192 |
apply (simp add: vimage_singleton_iff) |
|
193 |
apply (rule conjI) |
|
194 |
apply (blast dest: transD) |
|
13268 | 195 |
apply (rule_tac x="restrict(f, r -`` {y})" in rexI) |
196 |
apply (simp_all add: is_recfun_restrict |
|
197 |
apply_recfun is_recfun_type [THEN apply_iff]) |
|
13223 | 198 |
done |
199 |
||
13245 | 200 |
text{*For typical applications of Replacement for recursive definitions*} |
201 |
lemma (in M_axioms) univalent_is_recfun: |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
202 |
"[|wellfounded(M,r); trans(r); M(r)|] |
13268 | 203 |
==> univalent (M, A, \<lambda>x p. |
13293 | 204 |
\<exists>y[M]. p = \<langle>x,y\<rangle> & (\<exists>f[M]. is_recfun(r,x,H,f) & y = H(x,f)))" |
13245 | 205 |
apply (simp add: univalent_def) |
206 |
apply (blast dest: is_recfun_functional) |
|
207 |
done |
|
208 |
||
13299 | 209 |
|
13223 | 210 |
text{*Proof of the inductive step for @{text exists_is_recfun}, since |
211 |
we must prove two versions.*} |
|
212 |
lemma (in M_axioms) exists_is_recfun_indstep: |
|
13268 | 213 |
"[|\<forall>y. \<langle>y, a1\<rangle> \<in> r --> (\<exists>f[M]. is_recfun(r, y, H, f)); |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
214 |
wellfounded(M,r); trans(r); M(r); M(a1); |
13268 | 215 |
strong_replacement(M, \<lambda>x z. |
216 |
\<exists>y[M]. \<exists>g[M]. pair(M,x,y,z) & is_recfun(r,x,H,g) & y = H(x,g)); |
|
13254 | 217 |
\<forall>x[M]. \<forall>g[M]. function(g) --> M(H(x,g))|] |
13268 | 218 |
==> \<exists>f[M]. is_recfun(r,a1,H,f)" |
13223 | 219 |
apply (drule_tac A="r-``{a1}" in strong_replacementD) |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
220 |
apply blast |
13223 | 221 |
txt{*Discharge the "univalent" obligation of Replacement*} |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
222 |
apply (simp add: univalent_is_recfun) |
13223 | 223 |
txt{*Show that the constructed object satisfies @{text is_recfun}*} |
224 |
apply clarify |
|
13268 | 225 |
apply (rule_tac x=Y in rexI) |
13254 | 226 |
txt{*Unfold only the top-level occurrence of @{term is_recfun}*} |
227 |
apply (simp (no_asm_simp) add: is_recfun_relativize [of concl: _ a1]) |
|
13268 | 228 |
txt{*The big iff-formula defining @{term Y} is now redundant*} |
13254 | 229 |
apply safe |
13299 | 230 |
apply (simp add: vimage_singleton_iff restrict_Y_lemma [of r H _ a1]) |
13223 | 231 |
txt{*one more case*} |
13254 | 232 |
apply (simp (no_asm_simp) add: Bex_def vimage_singleton_iff) |
13223 | 233 |
apply (drule_tac x1=x in spec [THEN mp], assumption, clarify) |
13268 | 234 |
apply (rename_tac f) |
235 |
apply (rule_tac x=f in rexI) |
|
13293 | 236 |
apply (simp_all add: restrict_Y_lemma [of r H]) |
13299 | 237 |
txt{*FIXME: should not be needed!*} |
238 |
apply (subst restrict_Y_lemma [of r H]) |
|
239 |
apply (simp add: vimage_singleton_iff)+ |
|
240 |
apply blast+ |
|
13223 | 241 |
done |
242 |
||
243 |
text{*Relativized version, when we have the (currently weaker) premise |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
244 |
@{term "wellfounded(M,r)"}*} |
13223 | 245 |
lemma (in M_axioms) wellfounded_exists_is_recfun: |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
246 |
"[|wellfounded(M,r); trans(r); |
13268 | 247 |
separation(M, \<lambda>x. ~ (\<exists>f[M]. is_recfun(r, x, H, f))); |
248 |
strong_replacement(M, \<lambda>x z. |
|
249 |
\<exists>y[M]. \<exists>g[M]. pair(M,x,y,z) & is_recfun(r,x,H,g) & y = H(x,g)); |
|
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
250 |
M(r); M(a); |
13254 | 251 |
\<forall>x[M]. \<forall>g[M]. function(g) --> M(H(x,g)) |] |
13268 | 252 |
==> \<exists>f[M]. is_recfun(r,a,H,f)" |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
253 |
apply (rule wellfounded_induct, assumption+, clarify) |
13223 | 254 |
apply (rule exists_is_recfun_indstep, assumption+) |
255 |
done |
|
256 |
||
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
257 |
lemma (in M_axioms) wf_exists_is_recfun [rule_format]: |
13268 | 258 |
"[|wf(r); trans(r); M(r); |
259 |
strong_replacement(M, \<lambda>x z. |
|
260 |
\<exists>y[M]. \<exists>g[M]. pair(M,x,y,z) & is_recfun(r,x,H,g) & y = H(x,g)); |
|
13254 | 261 |
\<forall>x[M]. \<forall>g[M]. function(g) --> M(H(x,g)) |] |
13268 | 262 |
==> M(a) --> (\<exists>f[M]. is_recfun(r,a,H,f))" |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
263 |
apply (rule wf_induct, assumption+) |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
264 |
apply (frule wf_imp_relativized) |
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
265 |
apply (intro impI) |
13268 | 266 |
apply (rule exists_is_recfun_indstep) |
267 |
apply (blast dest: transM del: rev_rallE, assumption+) |
|
13223 | 268 |
done |
269 |
||
270 |
constdefs |
|
13254 | 271 |
M_is_recfun :: "[i=>o, i, i, [i=>o,i,i,i]=>o, i] => o" |
272 |
"M_is_recfun(M,r,a,MH,f) == |
|
273 |
\<forall>z[M]. z \<in> f <-> |
|
274 |
(\<exists>x[M]. \<exists>y[M]. \<exists>xa[M]. \<exists>sx[M]. \<exists>r_sx[M]. \<exists>f_r_sx[M]. |
|
275 |
pair(M,x,y,z) & pair(M,x,a,xa) & upair(M,x,x,sx) & |
|
276 |
pre_image(M,r,sx,r_sx) & restriction(M,f,r_sx,f_r_sx) & |
|
277 |
xa \<in> r & MH(M, x, f_r_sx, y))" |
|
13223 | 278 |
|
279 |
lemma (in M_axioms) is_recfun_iff_M: |
|
13254 | 280 |
"[| M(r); M(a); M(f); \<forall>x[M]. \<forall>g[M]. function(g) --> M(H(x,g)); |
13223 | 281 |
\<forall>x g y. M(x) --> M(g) --> M(y) --> MH(M,x,g,y) <-> y = H(x,g) |] ==> |
282 |
is_recfun(r,a,H,f) <-> M_is_recfun(M,r,a,MH,f)" |
|
13254 | 283 |
apply (simp add: M_is_recfun_def is_recfun_relativize) |
284 |
apply (rule rall_cong) |
|
285 |
apply (blast dest: transM) |
|
13223 | 286 |
done |
287 |
||
288 |
lemma M_is_recfun_cong [cong]: |
|
289 |
"[| r = r'; a = a'; f = f'; |
|
290 |
!!x g y. [| M(x); M(g); M(y) |] ==> MH(M,x,g,y) <-> MH'(M,x,g,y) |] |
|
291 |
==> M_is_recfun(M,r,a,MH,f) <-> M_is_recfun(M,r',a',MH',f')" |
|
292 |
by (simp add: M_is_recfun_def) |
|
293 |
||
294 |
||
295 |
constdefs |
|
296 |
(*This expresses ordinal addition as a formula in the LAST. It also |
|
297 |
provides an abbreviation that can be used in the instance of strong |
|
298 |
replacement below. Here j is used to define the relation, namely |
|
299 |
Memrel(succ(j)), while x determines the domain of f.*) |
|
300 |
is_oadd_fun :: "[i=>o,i,i,i,i] => o" |
|
301 |
"is_oadd_fun(M,i,j,x,f) == |
|
302 |
(\<forall>sj msj. M(sj) --> M(msj) --> |
|
303 |
successor(M,j,sj) --> membership(M,sj,msj) --> |
|
304 |
M_is_recfun(M, msj, x, |
|
305 |
%M x g y. \<exists>gx. M(gx) & image(M,g,x,gx) & union(M,i,gx,y), |
|
306 |
f))" |
|
307 |
||
308 |
is_oadd :: "[i=>o,i,i,i] => o" |
|
309 |
"is_oadd(M,i,j,k) == |
|
310 |
(~ ordinal(M,i) & ~ ordinal(M,j) & k=0) | |
|
311 |
(~ ordinal(M,i) & ordinal(M,j) & k=j) | |
|
312 |
(ordinal(M,i) & ~ ordinal(M,j) & k=i) | |
|
313 |
(ordinal(M,i) & ordinal(M,j) & |
|
314 |
(\<exists>f fj sj. M(f) & M(fj) & M(sj) & |
|
315 |
successor(M,j,sj) & is_oadd_fun(M,i,sj,sj,f) & |
|
316 |
fun_apply(M,f,j,fj) & fj = k))" |
|
317 |
||
318 |
(*NEEDS RELATIVIZATION*) |
|
319 |
omult_eqns :: "[i,i,i,i] => o" |
|
320 |
"omult_eqns(i,x,g,z) == |
|
321 |
Ord(x) & |
|
322 |
(x=0 --> z=0) & |
|
323 |
(\<forall>j. x = succ(j) --> z = g`j ++ i) & |
|
324 |
(Limit(x) --> z = \<Union>(g``x))" |
|
325 |
||
326 |
is_omult_fun :: "[i=>o,i,i,i] => o" |
|
327 |
"is_omult_fun(M,i,j,f) == |
|
328 |
(\<exists>df. M(df) & is_function(M,f) & |
|
329 |
is_domain(M,f,df) & subset(M, j, df)) & |
|
330 |
(\<forall>x\<in>j. omult_eqns(i,x,f,f`x))" |
|
331 |
||
332 |
is_omult :: "[i=>o,i,i,i] => o" |
|
333 |
"is_omult(M,i,j,k) == |
|
334 |
\<exists>f fj sj. M(f) & M(fj) & M(sj) & |
|
335 |
successor(M,j,sj) & is_omult_fun(M,i,sj,f) & |
|
336 |
fun_apply(M,f,j,fj) & fj = k" |
|
337 |
||
338 |
||
13268 | 339 |
locale M_ord_arith = M_axioms + |
13223 | 340 |
assumes oadd_strong_replacement: |
341 |
"[| M(i); M(j) |] ==> |
|
342 |
strong_replacement(M, |
|
13293 | 343 |
\<lambda>x z. \<exists>y[M]. pair(M,x,y,z) & |
344 |
(\<exists>f[M]. \<exists>fx[M]. is_oadd_fun(M,i,j,x,f) & |
|
345 |
image(M,f,x,fx) & y = i Un fx))" |
|
346 |
||
13223 | 347 |
and omult_strong_replacement': |
348 |
"[| M(i); M(j) |] ==> |
|
13293 | 349 |
strong_replacement(M, |
350 |
\<lambda>x z. \<exists>y[M]. z = <x,y> & |
|
351 |
(\<exists>g[M]. is_recfun(Memrel(succ(j)),x,%x g. THE z. omult_eqns(i,x,g,z),g) & |
|
352 |
y = (THE z. omult_eqns(i, x, g, z))))" |
|
13223 | 353 |
|
354 |
||
355 |
||
13295 | 356 |
text{*@{text is_oadd_fun}: Relating the pure "language of set theory" to Isabelle/ZF*} |
13268 | 357 |
lemma (in M_ord_arith) is_oadd_fun_iff: |
13223 | 358 |
"[| a\<le>j; M(i); M(j); M(a); M(f) |] |
359 |
==> is_oadd_fun(M,i,j,a,f) <-> |
|
360 |
f \<in> a \<rightarrow> range(f) & (\<forall>x. M(x) --> x < a --> f`x = i Un f``x)" |
|
361 |
apply (frule lt_Ord) |
|
362 |
apply (simp add: is_oadd_fun_def Memrel_closed Un_closed |
|
363 |
is_recfun_iff_M [of concl: _ _ "%x g. i Un g``x", THEN iff_sym] |
|
364 |
image_closed is_recfun_iff_equation |
|
365 |
Ball_def lt_trans [OF ltI, of _ a] lt_Memrel) |
|
366 |
apply (simp add: lt_def) |
|
367 |
apply (blast dest: transM) |
|
368 |
done |
|
369 |
||
370 |
||
13268 | 371 |
lemma (in M_ord_arith) oadd_strong_replacement': |
13223 | 372 |
"[| M(i); M(j) |] ==> |
13293 | 373 |
strong_replacement(M, |
374 |
\<lambda>x z. \<exists>y[M]. z = <x,y> & |
|
375 |
(\<exists>g[M]. is_recfun(Memrel(succ(j)),x,%x g. i Un g``x,g) & |
|
376 |
y = i Un g``x))" |
|
13223 | 377 |
apply (insert oadd_strong_replacement [of i j]) |
378 |
apply (simp add: Memrel_closed Un_closed image_closed is_oadd_fun_def |
|
379 |
is_recfun_iff_M) |
|
380 |
done |
|
381 |
||
382 |
||
13268 | 383 |
lemma (in M_ord_arith) exists_oadd: |
13223 | 384 |
"[| Ord(j); M(i); M(j) |] |
13268 | 385 |
==> \<exists>f[M]. is_recfun(Memrel(succ(j)), j, %x g. i Un g``x, f)" |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
386 |
apply (rule wf_exists_is_recfun [OF wf_Memrel trans_Memrel]) |
13268 | 387 |
apply (simp_all add: Memrel_type oadd_strong_replacement') |
388 |
done |
|
389 |
||
390 |
lemma (in M_ord_arith) exists_oadd_fun: |
|
391 |
"[| Ord(j); M(i); M(j) |] ==> \<exists>f[M]. is_oadd_fun(M,i,succ(j),succ(j),f)" |
|
392 |
apply (rule exists_oadd [THEN rexE]) |
|
393 |
apply (erule Ord_succ, assumption, simp) |
|
394 |
apply (rename_tac f) |
|
395 |
apply (frule is_recfun_type) |
|
396 |
apply (rule_tac x=f in rexI) |
|
397 |
apply (simp add: fun_is_function domain_of_fun lt_Memrel apply_recfun lt_def |
|
398 |
is_oadd_fun_iff Ord_trans [OF _ succI1], assumption) |
|
13223 | 399 |
done |
400 |
||
13268 | 401 |
lemma (in M_ord_arith) is_oadd_fun_apply: |
13223 | 402 |
"[| x < j; M(i); M(j); M(f); is_oadd_fun(M,i,j,j,f) |] |
403 |
==> f`x = i Un (\<Union>k\<in>x. {f ` k})" |
|
404 |
apply (simp add: is_oadd_fun_iff lt_Ord2, clarify) |
|
405 |
apply (frule lt_closed, simp) |
|
406 |
apply (frule leI [THEN le_imp_subset]) |
|
407 |
apply (simp add: image_fun, blast) |
|
408 |
done |
|
409 |
||
13268 | 410 |
lemma (in M_ord_arith) is_oadd_fun_iff_oadd [rule_format]: |
13223 | 411 |
"[| is_oadd_fun(M,i,J,J,f); M(i); M(J); M(f); Ord(i); Ord(j) |] |
412 |
==> j<J --> f`j = i++j" |
|
413 |
apply (erule_tac i=j in trans_induct, clarify) |
|
414 |
apply (subgoal_tac "\<forall>k\<in>x. k<J") |
|
415 |
apply (simp (no_asm_simp) add: is_oadd_def oadd_unfold is_oadd_fun_apply) |
|
416 |
apply (blast intro: lt_trans ltI lt_Ord) |
|
417 |
done |
|
418 |
||
13268 | 419 |
lemma (in M_ord_arith) oadd_abs_fun_apply_iff: |
13223 | 420 |
"[| M(i); M(J); M(f); M(k); j<J; is_oadd_fun(M,i,J,J,f) |] |
421 |
==> fun_apply(M,f,j,k) <-> f`j = k" |
|
422 |
by (force simp add: lt_def is_oadd_fun_iff subsetD typed_apply_abs) |
|
423 |
||
13268 | 424 |
lemma (in M_ord_arith) Ord_oadd_abs: |
13223 | 425 |
"[| M(i); M(j); M(k); Ord(i); Ord(j) |] ==> is_oadd(M,i,j,k) <-> k = i++j" |
426 |
apply (simp add: is_oadd_def oadd_abs_fun_apply_iff is_oadd_fun_iff_oadd) |
|
427 |
apply (frule exists_oadd_fun [of j i], blast+) |
|
428 |
done |
|
429 |
||
13268 | 430 |
lemma (in M_ord_arith) oadd_abs: |
13223 | 431 |
"[| M(i); M(j); M(k) |] ==> is_oadd(M,i,j,k) <-> k = i++j" |
432 |
apply (case_tac "Ord(i) & Ord(j)") |
|
433 |
apply (simp add: Ord_oadd_abs) |
|
434 |
apply (auto simp add: is_oadd_def oadd_eq_if_raw_oadd) |
|
435 |
done |
|
436 |
||
13268 | 437 |
lemma (in M_ord_arith) oadd_closed [intro,simp]: |
13223 | 438 |
"[| M(i); M(j) |] ==> M(i++j)" |
439 |
apply (simp add: oadd_eq_if_raw_oadd, clarify) |
|
440 |
apply (simp add: raw_oadd_eq_oadd) |
|
441 |
apply (frule exists_oadd_fun [of j i], auto) |
|
442 |
apply (simp add: apply_closed is_oadd_fun_iff_oadd [symmetric]) |
|
443 |
done |
|
444 |
||
445 |
||
446 |
text{*Ordinal Multiplication*} |
|
447 |
||
448 |
lemma omult_eqns_unique: |
|
449 |
"[| omult_eqns(i,x,g,z); omult_eqns(i,x,g,z') |] ==> z=z'"; |
|
450 |
apply (simp add: omult_eqns_def, clarify) |
|
451 |
apply (erule Ord_cases, simp_all) |
|
452 |
done |
|
453 |
||
454 |
lemma omult_eqns_0: "omult_eqns(i,0,g,z) <-> z=0" |
|
455 |
by (simp add: omult_eqns_def) |
|
456 |
||
457 |
lemma the_omult_eqns_0: "(THE z. omult_eqns(i,0,g,z)) = 0" |
|
458 |
by (simp add: omult_eqns_0) |
|
459 |
||
460 |
lemma omult_eqns_succ: "omult_eqns(i,succ(j),g,z) <-> Ord(j) & z = g`j ++ i" |
|
461 |
by (simp add: omult_eqns_def) |
|
462 |
||
463 |
lemma the_omult_eqns_succ: |
|
464 |
"Ord(j) ==> (THE z. omult_eqns(i,succ(j),g,z)) = g`j ++ i" |
|
465 |
by (simp add: omult_eqns_succ) |
|
466 |
||
467 |
lemma omult_eqns_Limit: |
|
468 |
"Limit(x) ==> omult_eqns(i,x,g,z) <-> z = \<Union>(g``x)" |
|
469 |
apply (simp add: omult_eqns_def) |
|
470 |
apply (blast intro: Limit_is_Ord) |
|
471 |
done |
|
472 |
||
473 |
lemma the_omult_eqns_Limit: |
|
474 |
"Limit(x) ==> (THE z. omult_eqns(i,x,g,z)) = \<Union>(g``x)" |
|
475 |
by (simp add: omult_eqns_Limit) |
|
476 |
||
477 |
lemma omult_eqns_Not: "~ Ord(x) ==> ~ omult_eqns(i,x,g,z)" |
|
478 |
by (simp add: omult_eqns_def) |
|
479 |
||
480 |
||
13268 | 481 |
lemma (in M_ord_arith) the_omult_eqns_closed: |
13223 | 482 |
"[| M(i); M(x); M(g); function(g) |] |
483 |
==> M(THE z. omult_eqns(i, x, g, z))" |
|
484 |
apply (case_tac "Ord(x)") |
|
485 |
prefer 2 apply (simp add: omult_eqns_Not) --{*trivial, non-Ord case*} |
|
486 |
apply (erule Ord_cases) |
|
487 |
apply (simp add: omult_eqns_0) |
|
488 |
apply (simp add: omult_eqns_succ apply_closed oadd_closed) |
|
489 |
apply (simp add: omult_eqns_Limit) |
|
490 |
done |
|
491 |
||
13268 | 492 |
lemma (in M_ord_arith) exists_omult: |
13223 | 493 |
"[| Ord(j); M(i); M(j) |] |
13268 | 494 |
==> \<exists>f[M]. is_recfun(Memrel(succ(j)), j, %x g. THE z. omult_eqns(i,x,g,z), f)" |
13251
74cb2af8811e
new treatment of wfrec, replacing wf[A](r) by wf(r)
paulson
parents:
13247
diff
changeset
|
495 |
apply (rule wf_exists_is_recfun [OF wf_Memrel trans_Memrel]) |
13268 | 496 |
apply (simp_all add: Memrel_type omult_strong_replacement') |
13223 | 497 |
apply (blast intro: the_omult_eqns_closed) |
498 |
done |
|
499 |
||
13268 | 500 |
lemma (in M_ord_arith) exists_omult_fun: |
501 |
"[| Ord(j); M(i); M(j) |] ==> \<exists>f[M]. is_omult_fun(M,i,succ(j),f)" |
|
502 |
apply (rule exists_omult [THEN rexE]) |
|
13223 | 503 |
apply (erule Ord_succ, assumption, simp) |
13268 | 504 |
apply (rename_tac f) |
13223 | 505 |
apply (frule is_recfun_type) |
13268 | 506 |
apply (rule_tac x=f in rexI) |
13223 | 507 |
apply (simp add: fun_is_function domain_of_fun lt_Memrel apply_recfun lt_def |
508 |
is_omult_fun_def Ord_trans [OF _ succI1]) |
|
13268 | 509 |
apply (force dest: Ord_in_Ord' |
510 |
simp add: omult_eqns_def the_omult_eqns_0 the_omult_eqns_succ |
|
511 |
the_omult_eqns_Limit, assumption) |
|
13223 | 512 |
done |
513 |
||
13268 | 514 |
lemma (in M_ord_arith) is_omult_fun_apply_0: |
13223 | 515 |
"[| 0 < j; is_omult_fun(M,i,j,f) |] ==> f`0 = 0" |
516 |
by (simp add: is_omult_fun_def omult_eqns_def lt_def ball_conj_distrib) |
|
517 |
||
13268 | 518 |
lemma (in M_ord_arith) is_omult_fun_apply_succ: |
13223 | 519 |
"[| succ(x) < j; is_omult_fun(M,i,j,f) |] ==> f`succ(x) = f`x ++ i" |
520 |
by (simp add: is_omult_fun_def omult_eqns_def lt_def, blast) |
|
521 |
||
13268 | 522 |
lemma (in M_ord_arith) is_omult_fun_apply_Limit: |
13223 | 523 |
"[| x < j; Limit(x); M(j); M(f); is_omult_fun(M,i,j,f) |] |
524 |
==> f ` x = (\<Union>y\<in>x. f`y)" |
|
525 |
apply (simp add: is_omult_fun_def omult_eqns_def domain_closed lt_def, clarify) |
|
526 |
apply (drule subset_trans [OF OrdmemD], assumption+) |
|
527 |
apply (simp add: ball_conj_distrib omult_Limit image_function) |
|
528 |
done |
|
529 |
||
13268 | 530 |
lemma (in M_ord_arith) is_omult_fun_eq_omult: |
13223 | 531 |
"[| is_omult_fun(M,i,J,f); M(J); M(f); Ord(i); Ord(j) |] |
532 |
==> j<J --> f`j = i**j" |
|
533 |
apply (erule_tac i=j in trans_induct3) |
|
534 |
apply (safe del: impCE) |
|
535 |
apply (simp add: is_omult_fun_apply_0) |
|
536 |
apply (subgoal_tac "x<J") |
|
537 |
apply (simp add: is_omult_fun_apply_succ omult_succ) |
|
538 |
apply (blast intro: lt_trans) |
|
539 |
apply (subgoal_tac "\<forall>k\<in>x. k<J") |
|
540 |
apply (simp add: is_omult_fun_apply_Limit omult_Limit) |
|
541 |
apply (blast intro: lt_trans ltI lt_Ord) |
|
542 |
done |
|
543 |
||
13268 | 544 |
lemma (in M_ord_arith) omult_abs_fun_apply_iff: |
13223 | 545 |
"[| M(i); M(J); M(f); M(k); j<J; is_omult_fun(M,i,J,f) |] |
546 |
==> fun_apply(M,f,j,k) <-> f`j = k" |
|
547 |
by (auto simp add: lt_def is_omult_fun_def subsetD apply_abs) |
|
548 |
||
13268 | 549 |
lemma (in M_ord_arith) omult_abs: |
13223 | 550 |
"[| M(i); M(j); M(k); Ord(i); Ord(j) |] ==> is_omult(M,i,j,k) <-> k = i**j" |
551 |
apply (simp add: is_omult_def omult_abs_fun_apply_iff is_omult_fun_eq_omult) |
|
552 |
apply (frule exists_omult_fun [of j i], blast+) |
|
553 |
done |
|
554 |
||
555 |
end |
|
556 |