src/HOL/Fun.thy
 author nipkow Tue Sep 06 14:25:16 2011 +0200 (2011-09-06) changeset 44744 bdf8eb8f126b parent 44277 bcb696533579 child 44860 56101fa00193 permissions -rw-r--r--
1 (*  Title:      HOL/Fun.thy
2     Author:     Tobias Nipkow, Cambridge University Computer Laboratory
3     Copyright   1994  University of Cambridge
4 *)
8 theory Fun
9 imports Complete_Lattice
10 uses ("Tools/enriched_type.ML")
11 begin
13 lemma apply_inverse:
14   "f x = u \<Longrightarrow> (\<And>x. P x \<Longrightarrow> g (f x) = x) \<Longrightarrow> P x \<Longrightarrow> x = g u"
15   by auto
18 subsection {* The Identity Function @{text id} *}
20 definition id :: "'a \<Rightarrow> 'a" where
21   "id = (\<lambda>x. x)"
23 lemma id_apply [simp]: "id x = x"
26 lemma image_id [simp]: "id ` Y = Y"
29 lemma vimage_id [simp]: "id -` A = A"
33 subsection {* The Composition Operator @{text "f \<circ> g"} *}
35 definition comp :: "('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'c" (infixl "o" 55) where
36   "f o g = (\<lambda>x. f (g x))"
38 notation (xsymbols)
39   comp  (infixl "\<circ>" 55)
41 notation (HTML output)
42   comp  (infixl "\<circ>" 55)
44 lemma o_apply [simp]: "(f o g) x = f (g x)"
47 lemma o_assoc: "f o (g o h) = f o g o h"
50 lemma id_o [simp]: "id o g = g"
53 lemma o_id [simp]: "f o id = f"
56 lemma o_eq_dest:
57   "a o b = c o d \<Longrightarrow> a (b v) = c (d v)"
58   by (simp only: comp_def) (fact fun_cong)
60 lemma o_eq_elim:
61   "a o b = c o d \<Longrightarrow> ((\<And>v. a (b v) = c (d v)) \<Longrightarrow> R) \<Longrightarrow> R"
62   by (erule meta_mp) (fact o_eq_dest)
64 lemma image_compose: "(f o g) ` r = f`(g`r)"
65 by (simp add: comp_def, blast)
67 lemma vimage_compose: "(g \<circ> f) -` x = f -` (g -` x)"
68   by auto
70 lemma UN_o: "UNION A (g o f) = UNION (f`A) g"
71 by (unfold comp_def, blast)
74 subsection {* The Forward Composition Operator @{text fcomp} *}
76 definition fcomp :: "('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> 'a \<Rightarrow> 'c" (infixl "\<circ>>" 60) where
77   "f \<circ>> g = (\<lambda>x. g (f x))"
79 lemma fcomp_apply [simp]:  "(f \<circ>> g) x = g (f x)"
82 lemma fcomp_assoc: "(f \<circ>> g) \<circ>> h = f \<circ>> (g \<circ>> h)"
85 lemma id_fcomp [simp]: "id \<circ>> g = g"
88 lemma fcomp_id [simp]: "f \<circ>> id = f"
91 code_const fcomp
92   (Eval infixl 1 "#>")
94 no_notation fcomp (infixl "\<circ>>" 60)
97 subsection {* Mapping functions *}
99 definition map_fun :: "('c \<Rightarrow> 'a) \<Rightarrow> ('b \<Rightarrow> 'd) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'c \<Rightarrow> 'd" where
100   "map_fun f g h = g \<circ> h \<circ> f"
102 lemma map_fun_apply [simp]:
103   "map_fun f g h x = g (h (f x))"
107 subsection {* Injectivity and Bijectivity *}
109 definition inj_on :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> bool" where -- "injective"
110   "inj_on f A \<longleftrightarrow> (\<forall>x\<in>A. \<forall>y\<in>A. f x = f y \<longrightarrow> x = y)"
112 definition bij_betw :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> bool" where -- "bijective"
113   "bij_betw f A B \<longleftrightarrow> inj_on f A \<and> f ` A = B"
115 text{*A common special case: functions injective, surjective or bijective over
116 the entire domain type.*}
118 abbreviation
119   "inj f \<equiv> inj_on f UNIV"
121 abbreviation surj :: "('a \<Rightarrow> 'b) \<Rightarrow> bool" where -- "surjective"
122   "surj f \<equiv> (range f = UNIV)"
124 abbreviation
125   "bij f \<equiv> bij_betw f UNIV UNIV"
127 text{* The negated case: *}
128 translations
129 "\<not> CONST surj f" <= "CONST range f \<noteq> CONST UNIV"
131 lemma injI:
132   assumes "\<And>x y. f x = f y \<Longrightarrow> x = y"
133   shows "inj f"
134   using assms unfolding inj_on_def by auto
136 theorem range_ex1_eq: "inj f \<Longrightarrow> b : range f = (EX! x. b = f x)"
137   by (unfold inj_on_def, blast)
139 lemma injD: "[| inj(f); f(x) = f(y) |] ==> x=y"
142 lemma inj_on_eq_iff: "inj_on f A ==> x:A ==> y:A ==> (f(x) = f(y)) = (x=y)"
143 by (force simp add: inj_on_def)
145 lemma inj_on_cong:
146   "(\<And> a. a : A \<Longrightarrow> f a = g a) \<Longrightarrow> inj_on f A = inj_on g A"
147 unfolding inj_on_def by auto
149 lemma inj_on_strict_subset:
150   "\<lbrakk> inj_on f B; A < B \<rbrakk> \<Longrightarrow> f`A < f`B"
151 unfolding inj_on_def unfolding image_def by blast
153 lemma inj_comp:
154   "inj f \<Longrightarrow> inj g \<Longrightarrow> inj (f \<circ> g)"
157 lemma inj_fun: "inj f \<Longrightarrow> inj (\<lambda>x y. f x)"
158   by (simp add: inj_on_def fun_eq_iff)
160 lemma inj_eq: "inj f ==> (f(x) = f(y)) = (x=y)"
163 lemma inj_on_id[simp]: "inj_on id A"
166 lemma inj_on_id2[simp]: "inj_on (%x. x) A"
169 lemma inj_on_Int: "\<lbrakk>inj_on f A; inj_on f B\<rbrakk> \<Longrightarrow> inj_on f (A \<inter> B)"
170 unfolding inj_on_def by blast
172 lemma inj_on_INTER:
173   "\<lbrakk>I \<noteq> {}; \<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)\<rbrakk> \<Longrightarrow> inj_on f (\<Inter> i \<in> I. A i)"
174 unfolding inj_on_def by blast
176 lemma inj_on_Inter:
177   "\<lbrakk>S \<noteq> {}; \<And> A. A \<in> S \<Longrightarrow> inj_on f A\<rbrakk> \<Longrightarrow> inj_on f (Inter S)"
178 unfolding inj_on_def by blast
180 lemma inj_on_UNION_chain:
181   assumes CH: "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i \<le> A j \<or> A j \<le> A i" and
182          INJ: "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
183   shows "inj_on f (\<Union> i \<in> I. A i)"
184 proof(unfold inj_on_def UNION_def, auto)
185   fix i j x y
186   assume *: "i \<in> I" "j \<in> I" and **: "x \<in> A i" "y \<in> A j"
187          and ***: "f x = f y"
188   show "x = y"
189   proof-
190     {assume "A i \<le> A j"
191      with ** have "x \<in> A j" by auto
192      with INJ * ** *** have ?thesis
194     }
195     moreover
196     {assume "A j \<le> A i"
197      with ** have "y \<in> A i" by auto
198      with INJ * ** *** have ?thesis
200     }
201     ultimately show ?thesis using  CH * by blast
202   qed
203 qed
205 lemma surj_id: "surj id"
206 by simp
208 lemma bij_id[simp]: "bij id"
211 lemma inj_onI:
212     "(!! x y. [|  x:A;  y:A;  f(x) = f(y) |] ==> x=y) ==> inj_on f A"
215 lemma inj_on_inverseI: "(!!x. x:A ==> g(f(x)) = x) ==> inj_on f A"
216 by (auto dest:  arg_cong [of concl: g] simp add: inj_on_def)
218 lemma inj_onD: "[| inj_on f A;  f(x)=f(y);  x:A;  y:A |] ==> x=y"
219 by (unfold inj_on_def, blast)
221 lemma inj_on_iff: "[| inj_on f A;  x:A;  y:A |] ==> (f(x)=f(y)) = (x=y)"
222 by (blast dest!: inj_onD)
224 lemma comp_inj_on:
225      "[| inj_on f A;  inj_on g (f`A) |] ==> inj_on (g o f) A"
226 by (simp add: comp_def inj_on_def)
228 lemma inj_on_imageI: "inj_on (g o f) A \<Longrightarrow> inj_on g (f ` A)"
230 apply blast
231 done
233 lemma inj_on_image_iff: "\<lbrakk> ALL x:A. ALL y:A. (g(f x) = g(f y)) = (g x = g y);
234   inj_on f A \<rbrakk> \<Longrightarrow> inj_on g (f ` A) = inj_on g A"
235 apply(unfold inj_on_def)
236 apply blast
237 done
239 lemma inj_on_contraD: "[| inj_on f A;  ~x=y;  x:A;  y:A |] ==> ~ f(x)=f(y)"
240 by (unfold inj_on_def, blast)
242 lemma inj_singleton: "inj (%s. {s})"
245 lemma inj_on_empty[iff]: "inj_on f {}"
248 lemma subset_inj_on: "[| inj_on f B; A <= B |] ==> inj_on f A"
249 by (unfold inj_on_def, blast)
251 lemma inj_on_Un:
252  "inj_on f (A Un B) =
253   (inj_on f A & inj_on f B & f`(A-B) Int f`(B-A) = {})"
254 apply(unfold inj_on_def)
255 apply (blast intro:sym)
256 done
258 lemma inj_on_insert[iff]:
259   "inj_on f (insert a A) = (inj_on f A & f a ~: f`(A-{a}))"
260 apply(unfold inj_on_def)
261 apply (blast intro:sym)
262 done
264 lemma inj_on_diff: "inj_on f A ==> inj_on f (A-B)"
265 apply(unfold inj_on_def)
266 apply (blast)
267 done
269 lemma comp_inj_on_iff:
270   "inj_on f A \<Longrightarrow> inj_on f' (f ` A) \<longleftrightarrow> inj_on (f' o f) A"
271 by(auto simp add: comp_inj_on inj_on_def)
273 lemma inj_on_imageI2:
274   "inj_on (f' o f) A \<Longrightarrow> inj_on f A"
275 by(auto simp add: comp_inj_on inj_on_def)
277 lemma surj_def: "surj f \<longleftrightarrow> (\<forall>y. \<exists>x. y = f x)"
278   by auto
280 lemma surjI: assumes *: "\<And> x. g (f x) = x" shows "surj g"
281   using *[symmetric] by auto
283 lemma surjD: "surj f \<Longrightarrow> \<exists>x. y = f x"
286 lemma surjE: "surj f \<Longrightarrow> (\<And>x. y = f x \<Longrightarrow> C) \<Longrightarrow> C"
287   by (simp add: surj_def, blast)
289 lemma comp_surj: "[| surj f;  surj g |] ==> surj (g o f)"
290 apply (simp add: comp_def surj_def, clarify)
291 apply (drule_tac x = y in spec, clarify)
292 apply (drule_tac x = x in spec, blast)
293 done
295 lemma bij_betw_imp_surj: "bij_betw f A UNIV \<Longrightarrow> surj f"
296   unfolding bij_betw_def by auto
298 lemma bij_betw_empty1:
299   assumes "bij_betw f {} A"
300   shows "A = {}"
301 using assms unfolding bij_betw_def by blast
303 lemma bij_betw_empty2:
304   assumes "bij_betw f A {}"
305   shows "A = {}"
306 using assms unfolding bij_betw_def by blast
308 lemma inj_on_imp_bij_betw:
309   "inj_on f A \<Longrightarrow> bij_betw f A (f ` A)"
310 unfolding bij_betw_def by simp
312 lemma bij_def: "bij f \<longleftrightarrow> inj f \<and> surj f"
313   unfolding bij_betw_def ..
315 lemma bijI: "[| inj f; surj f |] ==> bij f"
318 lemma bij_is_inj: "bij f ==> inj f"
321 lemma bij_is_surj: "bij f ==> surj f"
324 lemma bij_betw_imp_inj_on: "bij_betw f A B \<Longrightarrow> inj_on f A"
327 lemma bij_betw_trans:
328   "bij_betw f A B \<Longrightarrow> bij_betw g B C \<Longrightarrow> bij_betw (g o f) A C"
331 lemma bij_comp: "bij f \<Longrightarrow> bij g \<Longrightarrow> bij (g o f)"
332   by (rule bij_betw_trans)
334 lemma bij_betw_comp_iff:
335   "bij_betw f A A' \<Longrightarrow> bij_betw f' A' A'' \<longleftrightarrow> bij_betw (f' o f) A A''"
336 by(auto simp add: bij_betw_def inj_on_def)
338 lemma bij_betw_comp_iff2:
339   assumes BIJ: "bij_betw f' A' A''" and IM: "f ` A \<le> A'"
340   shows "bij_betw f A A' \<longleftrightarrow> bij_betw (f' o f) A A''"
341 using assms
343   assume *: "bij_betw (f' \<circ> f) A A''"
344   thus "bij_betw f A A'"
345   using IM
347     assume "inj_on (f' \<circ> f) A"
348     thus "inj_on f A" using inj_on_imageI2 by blast
349   next
350     fix a' assume **: "a' \<in> A'"
351     hence "f' a' \<in> A''" using BIJ unfolding bij_betw_def by auto
352     then obtain a where 1: "a \<in> A \<and> f'(f a) = f' a'" using *
353     unfolding bij_betw_def by force
354     hence "f a \<in> A'" using IM by auto
355     hence "f a = a'" using BIJ ** 1 unfolding bij_betw_def inj_on_def by auto
356     thus "a' \<in> f ` A" using 1 by auto
357   qed
358 qed
360 lemma bij_betw_inv: assumes "bij_betw f A B" shows "EX g. bij_betw g B A"
361 proof -
362   have i: "inj_on f A" and s: "f ` A = B"
363     using assms by(auto simp:bij_betw_def)
364   let ?P = "%b a. a:A \<and> f a = b" let ?g = "%b. The (?P b)"
365   { fix a b assume P: "?P b a"
366     hence ex1: "\<exists>a. ?P b a" using s unfolding image_def by blast
367     hence uex1: "\<exists>!a. ?P b a" by(blast dest:inj_onD[OF i])
368     hence " ?g b = a" using the1_equality[OF uex1, OF P] P by simp
369   } note g = this
370   have "inj_on ?g B"
371   proof(rule inj_onI)
372     fix x y assume "x:B" "y:B" "?g x = ?g y"
373     from s `x:B` obtain a1 where a1: "?P x a1" unfolding image_def by blast
374     from s `y:B` obtain a2 where a2: "?P y a2" unfolding image_def by blast
375     from g[OF a1] a1 g[OF a2] a2 `?g x = ?g y` show "x=y" by simp
376   qed
377   moreover have "?g ` B = A"
378   proof(auto simp:image_def)
379     fix b assume "b:B"
380     with s obtain a where P: "?P b a" unfolding image_def by blast
381     thus "?g b \<in> A" using g[OF P] by auto
382   next
383     fix a assume "a:A"
384     then obtain b where P: "?P b a" using s unfolding image_def by blast
385     then have "b:B" using s unfolding image_def by blast
386     with g[OF P] show "\<exists>b\<in>B. a = ?g b" by blast
387   qed
388   ultimately show ?thesis by(auto simp:bij_betw_def)
389 qed
391 lemma bij_betw_cong:
392   "(\<And> a. a \<in> A \<Longrightarrow> f a = g a) \<Longrightarrow> bij_betw f A A' = bij_betw g A A'"
393 unfolding bij_betw_def inj_on_def by force
395 lemma bij_betw_id[intro, simp]:
396   "bij_betw id A A"
397 unfolding bij_betw_def id_def by auto
399 lemma bij_betw_id_iff:
400   "bij_betw id A B \<longleftrightarrow> A = B"
403 lemma bij_betw_combine:
404   assumes "bij_betw f A B" "bij_betw f C D" "B \<inter> D = {}"
405   shows "bij_betw f (A \<union> C) (B \<union> D)"
406   using assms unfolding bij_betw_def inj_on_Un image_Un by auto
408 lemma bij_betw_UNION_chain:
409   assumes CH: "\<And> i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> A i \<le> A j \<or> A j \<le> A i" and
410          BIJ: "\<And> i. i \<in> I \<Longrightarrow> bij_betw f (A i) (A' i)"
411   shows "bij_betw f (\<Union> i \<in> I. A i) (\<Union> i \<in> I. A' i)"
412 proof(unfold bij_betw_def, auto simp add: image_def)
413   have "\<And> i. i \<in> I \<Longrightarrow> inj_on f (A i)"
414   using BIJ bij_betw_def[of f] by auto
415   thus "inj_on f (\<Union> i \<in> I. A i)"
416   using CH inj_on_UNION_chain[of I A f] by auto
417 next
418   fix i x
419   assume *: "i \<in> I" "x \<in> A i"
420   hence "f x \<in> A' i" using BIJ bij_betw_def[of f] by auto
421   thus "\<exists>j \<in> I. f x \<in> A' j" using * by blast
422 next
423   fix i x'
424   assume *: "i \<in> I" "x' \<in> A' i"
425   hence "\<exists>x \<in> A i. x' = f x" using BIJ bij_betw_def[of f] by blast
426   thus "\<exists>j \<in> I. \<exists>x \<in> A j. x' = f x"
427   using * by blast
428 qed
430 lemma bij_betw_Disj_Un:
431   assumes DISJ: "A \<inter> B = {}" and DISJ': "A' \<inter> B' = {}" and
432           B1: "bij_betw f A A'" and B2: "bij_betw f B B'"
433   shows "bij_betw f (A \<union> B) (A' \<union> B')"
434 proof-
435   have 1: "inj_on f A \<and> inj_on f B"
436   using B1 B2 by (auto simp add: bij_betw_def)
437   have 2: "f`A = A' \<and> f`B = B'"
438   using B1 B2 by (auto simp add: bij_betw_def)
439   hence "f`(A - B) \<inter> f`(B - A) = {}"
440   using DISJ DISJ' by blast
441   hence "inj_on f (A \<union> B)"
442   using 1 by (auto simp add: inj_on_Un)
443   (*  *)
444   moreover
445   have "f`(A \<union> B) = A' \<union> B'"
446   using 2 by auto
447   ultimately show ?thesis
448   unfolding bij_betw_def by auto
449 qed
451 lemma bij_betw_subset:
452   assumes BIJ: "bij_betw f A A'" and
453           SUB: "B \<le> A" and IM: "f ` B = B'"
454   shows "bij_betw f B B'"
455 using assms
456 by(unfold bij_betw_def inj_on_def, auto simp add: inj_on_def)
458 lemma surj_image_vimage_eq: "surj f ==> f ` (f -` A) = A"
459 by simp
461 lemma surj_vimage_empty:
462   assumes "surj f" shows "f -` A = {} \<longleftrightarrow> A = {}"
463   using surj_image_vimage_eq[OF `surj f`, of A]
464   by (intro iffI) fastsimp+
466 lemma inj_vimage_image_eq: "inj f ==> f -` (f ` A) = A"
467 by (simp add: inj_on_def, blast)
469 lemma vimage_subsetD: "surj f ==> f -` B <= A ==> B <= f ` A"
470 by (blast intro: sym)
472 lemma vimage_subsetI: "inj f ==> B <= f ` A ==> f -` B <= A"
473 by (unfold inj_on_def, blast)
475 lemma vimage_subset_eq: "bij f ==> (f -` B <= A) = (B <= f ` A)"
476 apply (unfold bij_def)
477 apply (blast del: subsetI intro: vimage_subsetI vimage_subsetD)
478 done
480 lemma inj_on_Un_image_eq_iff: "inj_on f (A \<union> B) \<Longrightarrow> f ` A = f ` B \<longleftrightarrow> A = B"
481 by(blast dest: inj_onD)
483 lemma inj_on_image_Int:
484    "[| inj_on f C;  A<=C;  B<=C |] ==> f`(A Int B) = f`A Int f`B"
485 apply (simp add: inj_on_def, blast)
486 done
488 lemma inj_on_image_set_diff:
489    "[| inj_on f C;  A<=C;  B<=C |] ==> f`(A-B) = f`A - f`B"
490 apply (simp add: inj_on_def, blast)
491 done
493 lemma image_Int: "inj f ==> f`(A Int B) = f`A Int f`B"
494 by (simp add: inj_on_def, blast)
496 lemma image_set_diff: "inj f ==> f`(A-B) = f`A - f`B"
497 by (simp add: inj_on_def, blast)
499 lemma inj_image_mem_iff: "inj f ==> (f a : f`A) = (a : A)"
500 by (blast dest: injD)
502 lemma inj_image_subset_iff: "inj f ==> (f`A <= f`B) = (A<=B)"
503 by (simp add: inj_on_def, blast)
505 lemma inj_image_eq_iff: "inj f ==> (f`A = f`B) = (A = B)"
506 by (blast dest: injD)
508 (*injectivity's required.  Left-to-right inclusion holds even if A is empty*)
509 lemma image_INT:
510    "[| inj_on f C;  ALL x:A. B x <= C;  j:A |]
511     ==> f ` (INTER A B) = (INT x:A. f ` B x)"
512 apply (simp add: inj_on_def, blast)
513 done
515 (*Compare with image_INT: no use of inj_on, and if f is surjective then
516   it doesn't matter whether A is empty*)
517 lemma bij_image_INT: "bij f ==> f ` (INTER A B) = (INT x:A. f ` B x)"
519 apply (simp add: inj_on_def surj_def, blast)
520 done
522 lemma surj_Compl_image_subset: "surj f ==> -(f`A) <= f`(-A)"
523 by auto
525 lemma inj_image_Compl_subset: "inj f ==> f`(-A) <= -(f`A)"
526 by (auto simp add: inj_on_def)
528 lemma bij_image_Compl_eq: "bij f ==> f`(-A) = -(f`A)"
530 apply (rule equalityI)
531 apply (simp_all (no_asm_simp) add: inj_image_Compl_subset surj_Compl_image_subset)
532 done
534 lemma inj_vimage_singleton: "inj f \<Longrightarrow> f -` {a} \<subseteq> {THE x. f x = a}"
535   -- {* The inverse image of a singleton under an injective function
536          is included in a singleton. *}
537   apply (auto simp add: inj_on_def)
538   apply (blast intro: the_equality [symmetric])
539   done
541 lemma inj_on_vimage_singleton:
542   "inj_on f A \<Longrightarrow> f -` {a} \<inter> A \<subseteq> {THE x. x \<in> A \<and> f x = a}"
543   by (auto simp add: inj_on_def intro: the_equality [symmetric])
545 lemma (in ordered_ab_group_add) inj_uminus[simp, intro]: "inj_on uminus A"
546   by (auto intro!: inj_onI)
548 lemma (in linorder) strict_mono_imp_inj_on: "strict_mono f \<Longrightarrow> inj_on f A"
549   by (auto intro!: inj_onI dest: strict_mono_eq)
552 subsection{*Function Updating*}
554 definition fun_upd :: "('a => 'b) => 'a => 'b => ('a => 'b)" where
555   "fun_upd f a b == % x. if x=a then b else f x"
557 nonterminal updbinds and updbind
559 syntax
560   "_updbind" :: "['a, 'a] => updbind"             ("(2_ :=/ _)")
561   ""         :: "updbind => updbinds"             ("_")
562   "_updbinds":: "[updbind, updbinds] => updbinds" ("_,/ _")
563   "_Update"  :: "['a, updbinds] => 'a"            ("_/'((_)')" [1000, 0] 900)
565 translations
566   "_Update f (_updbinds b bs)" == "_Update (_Update f b) bs"
567   "f(x:=y)" == "CONST fun_upd f x y"
569 (* Hint: to define the sum of two functions (or maps), use sum_case.
570          A nice infix syntax could be defined (in Datatype.thy or below) by
571 notation
572   sum_case  (infixr "'(+')"80)
573 *)
575 lemma fun_upd_idem_iff: "(f(x:=y) = f) = (f x = y)"
576 apply (simp add: fun_upd_def, safe)
577 apply (erule subst)
578 apply (rule_tac [2] ext, auto)
579 done
581 (* f x = y ==> f(x:=y) = f *)
582 lemmas fun_upd_idem = fun_upd_idem_iff [THEN iffD2, standard]
584 (* f(x := f x) = f *)
585 lemmas fun_upd_triv = refl [THEN fun_upd_idem]
586 declare fun_upd_triv [iff]
588 lemma fun_upd_apply [simp]: "(f(x:=y))z = (if z=x then y else f z)"
591 (* fun_upd_apply supersedes these two,   but they are useful
592    if fun_upd_apply is intentionally removed from the simpset *)
593 lemma fun_upd_same: "(f(x:=y)) x = y"
594 by simp
596 lemma fun_upd_other: "z~=x ==> (f(x:=y)) z = f z"
597 by simp
599 lemma fun_upd_upd [simp]: "f(x:=y,x:=z) = f(x:=z)"
602 lemma fun_upd_twist: "a ~= c ==> (m(a:=b))(c:=d) = (m(c:=d))(a:=b)"
603 by (rule ext, auto)
605 lemma inj_on_fun_updI: "\<lbrakk> inj_on f A; y \<notin> f`A \<rbrakk> \<Longrightarrow> inj_on (f(x:=y)) A"
606 by (fastsimp simp:inj_on_def image_def)
608 lemma fun_upd_image:
609      "f(x:=y) ` A = (if x \<in> A then insert y (f ` (A-{x})) else f ` A)"
610 by auto
612 lemma fun_upd_comp: "f \<circ> (g(x := y)) = (f \<circ> g)(x := f y)"
613 by (auto intro: ext)
615 lemma UNION_fun_upd:
616   "UNION J (A(i:=B)) = (UNION (J-{i}) A \<union> (if i\<in>J then B else {}))"
617 by (auto split: if_splits)
620 subsection {* @{text override_on} *}
622 definition override_on :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> 'b" where
623   "override_on f g A = (\<lambda>a. if a \<in> A then g a else f a)"
625 lemma override_on_emptyset[simp]: "override_on f g {} = f"
628 lemma override_on_apply_notin[simp]: "a ~: A ==> (override_on f g A) a = f a"
631 lemma override_on_apply_in[simp]: "a : A ==> (override_on f g A) a = g a"
635 subsection {* @{text swap} *}
637 definition swap :: "'a \<Rightarrow> 'a \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b)" where
638   "swap a b f = f (a := f b, b:= f a)"
640 lemma swap_self [simp]: "swap a a f = f"
643 lemma swap_commute: "swap a b f = swap b a f"
644 by (rule ext, simp add: fun_upd_def swap_def)
646 lemma swap_nilpotent [simp]: "swap a b (swap a b f) = f"
647 by (rule ext, simp add: fun_upd_def swap_def)
649 lemma swap_triple:
650   assumes "a \<noteq> c" and "b \<noteq> c"
651   shows "swap a b (swap b c (swap a b f)) = swap a c f"
652   using assms by (simp add: fun_eq_iff swap_def)
654 lemma comp_swap: "f \<circ> swap a b g = swap a b (f \<circ> g)"
655 by (rule ext, simp add: fun_upd_def swap_def)
657 lemma swap_image_eq [simp]:
658   assumes "a \<in> A" "b \<in> A" shows "swap a b f ` A = f ` A"
659 proof -
660   have subset: "\<And>f. swap a b f ` A \<subseteq> f ` A"
661     using assms by (auto simp: image_iff swap_def)
662   then have "swap a b (swap a b f) ` A \<subseteq> (swap a b f) ` A" .
663   with subset[of f] show ?thesis by auto
664 qed
666 lemma inj_on_imp_inj_on_swap:
667   "\<lbrakk>inj_on f A; a \<in> A; b \<in> A\<rbrakk> \<Longrightarrow> inj_on (swap a b f) A"
668   by (simp add: inj_on_def swap_def, blast)
670 lemma inj_on_swap_iff [simp]:
671   assumes A: "a \<in> A" "b \<in> A" shows "inj_on (swap a b f) A \<longleftrightarrow> inj_on f A"
672 proof
673   assume "inj_on (swap a b f) A"
674   with A have "inj_on (swap a b (swap a b f)) A"
675     by (iprover intro: inj_on_imp_inj_on_swap)
676   thus "inj_on f A" by simp
677 next
678   assume "inj_on f A"
679   with A show "inj_on (swap a b f) A" by (iprover intro: inj_on_imp_inj_on_swap)
680 qed
682 lemma surj_imp_surj_swap: "surj f \<Longrightarrow> surj (swap a b f)"
683   by simp
685 lemma surj_swap_iff [simp]: "surj (swap a b f) \<longleftrightarrow> surj f"
686   by simp
688 lemma bij_betw_swap_iff [simp]:
689   "\<lbrakk> x \<in> A; y \<in> A \<rbrakk> \<Longrightarrow> bij_betw (swap x y f) A B \<longleftrightarrow> bij_betw f A B"
690   by (auto simp: bij_betw_def)
692 lemma bij_swap_iff [simp]: "bij (swap a b f) \<longleftrightarrow> bij f"
693   by simp
695 hide_const (open) swap
697 subsection {* Inversion of injective functions *}
699 definition the_inv_into :: "'a set => ('a => 'b) => ('b => 'a)" where
700   "the_inv_into A f == %x. THE y. y : A & f y = x"
702 lemma the_inv_into_f_f:
703   "[| inj_on f A;  x : A |] ==> the_inv_into A f (f x) = x"
704 apply (simp add: the_inv_into_def inj_on_def)
705 apply blast
706 done
708 lemma f_the_inv_into_f:
709   "inj_on f A ==> y : f`A  ==> f (the_inv_into A f y) = y"
711 apply (rule the1I2)
712  apply(blast dest: inj_onD)
713 apply blast
714 done
716 lemma the_inv_into_into:
717   "[| inj_on f A; x : f ` A; A <= B |] ==> the_inv_into A f x : B"
719 apply (rule the1I2)
720  apply(blast dest: inj_onD)
721 apply blast
722 done
724 lemma the_inv_into_onto[simp]:
725   "inj_on f A ==> the_inv_into A f ` (f ` A) = A"
726 by (fast intro:the_inv_into_into the_inv_into_f_f[symmetric])
728 lemma the_inv_into_f_eq:
729   "[| inj_on f A; f x = y; x : A |] ==> the_inv_into A f y = x"
730   apply (erule subst)
731   apply (erule the_inv_into_f_f, assumption)
732   done
734 lemma the_inv_into_comp:
735   "[| inj_on f (g ` A); inj_on g A; x : f ` g ` A |] ==>
736   the_inv_into A (f o g) x = (the_inv_into A g o the_inv_into (g ` A) f) x"
737 apply (rule the_inv_into_f_eq)
738   apply (fast intro: comp_inj_on)
739  apply (simp add: f_the_inv_into_f the_inv_into_into)
741 done
743 lemma inj_on_the_inv_into:
744   "inj_on f A \<Longrightarrow> inj_on (the_inv_into A f) (f ` A)"
745 by (auto intro: inj_onI simp: image_def the_inv_into_f_f)
747 lemma bij_betw_the_inv_into:
748   "bij_betw f A B \<Longrightarrow> bij_betw (the_inv_into A f) B A"
749 by (auto simp add: bij_betw_def inj_on_the_inv_into the_inv_into_into)
751 abbreviation the_inv :: "('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a)" where
752   "the_inv f \<equiv> the_inv_into UNIV f"
754 lemma the_inv_f_f:
755   assumes "inj f"
756   shows "the_inv f (f x) = x" using assms UNIV_I
757   by (rule the_inv_into_f_f)
760 text{*compatibility*}
761 lemmas o_def = comp_def
764 subsection {* Cantor's Paradox *}
767   "\<not>(\<exists>f. f ` A = Pow A)"
768 proof clarify
769   fix f assume "f ` A = Pow A" hence *: "Pow A \<le> f ` A" by blast
770   let ?X = "{a \<in> A. a \<notin> f a}"
771   have "?X \<in> Pow A" unfolding Pow_def by auto
772   with * obtain x where "x \<in> A \<and> f x = ?X" by blast
773   thus False by best
774 qed
776 subsection {* Setup *}
778 subsubsection {* Proof tools *}
780 text {* simplifies terms of the form
781   f(...,x:=y,...,x:=z,...) to f(...,x:=z,...) *}
783 simproc_setup fun_upd2 ("f(v := w, x := y)") = {* fn _ =>
784 let
785   fun gen_fun_upd NONE T _ _ = NONE
786     | gen_fun_upd (SOME f) T x y = SOME (Const (@{const_name fun_upd}, T) \$ f \$ x \$ y)
787   fun dest_fun_T1 (Type (_, T :: Ts)) = T
788   fun find_double (t as Const (@{const_name fun_upd},T) \$ f \$ x \$ y) =
789     let
790       fun find (Const (@{const_name fun_upd},T) \$ g \$ v \$ w) =
791             if v aconv x then SOME g else gen_fun_upd (find g) T v w
792         | find t = NONE
793     in (dest_fun_T1 T, gen_fun_upd (find f) T x y) end
795   fun proc ss ct =
796     let
797       val ctxt = Simplifier.the_context ss
798       val t = Thm.term_of ct
799     in
800       case find_double t of
801         (T, NONE) => NONE
802       | (T, SOME rhs) =>
803           SOME (Goal.prove ctxt [] [] (Logic.mk_equals (t, rhs))
804             (fn _ =>
805               rtac eq_reflection 1 THEN
806               rtac ext 1 THEN
807               simp_tac (Simplifier.inherit_context ss @{simpset}) 1))
808     end
809 in proc end
810 *}
813 subsubsection {* Code generator *}
815 types_code
816   "fun"  ("(_ ->/ _)")
817 attach (term_of) {*
818 fun term_of_fun_type _ aT _ bT _ = Free ("<function>", aT --> bT);
819 *}
820 attach (test) {*
821 fun gen_fun_type aF aT bG bT i =
822   let
823     val tab = Unsynchronized.ref [];
824     fun mk_upd (x, (_, y)) t = Const ("Fun.fun_upd",
825       (aT --> bT) --> aT --> bT --> aT --> bT) \$ t \$ aF x \$ y ()
826   in
827     (fn x =>
828        case AList.lookup op = (!tab) x of
829          NONE =>
830            let val p as (y, _) = bG i
831            in (tab := (x, p) :: !tab; y) end
832        | SOME (y, _) => y,
833      fn () => Basics.fold mk_upd (!tab) (Const ("HOL.undefined", aT --> bT)))
834   end;
835 *}
837 code_const "op \<circ>"
838   (SML infixl 5 "o")