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