diff -r c09598a97436 -r d8d85a8172b5 src/HOL/Finite_Set.thy --- a/src/HOL/Finite_Set.thy Sat Jul 18 21:44:18 2015 +0200 +++ b/src/HOL/Finite_Set.thy Sat Jul 18 22:58:50 2015 +0200 @@ -3,30 +3,30 @@ with contributions by Jeremy Avigad and Andrei Popescu *) -section {* Finite sets *} +section \Finite sets\ theory Finite_Set imports Product_Type Sum_Type Nat begin -subsection {* Predicate for finite sets *} +subsection \Predicate for finite sets\ inductive finite :: "'a set \ bool" where emptyI [simp, intro!]: "finite {}" | insertI [simp, intro!]: "finite A \ finite (insert a A)" -simproc_setup finite_Collect ("finite (Collect P)") = {* K Set_Comprehension_Pointfree.simproc *} +simproc_setup finite_Collect ("finite (Collect P)") = \K Set_Comprehension_Pointfree.simproc\ declare [[simproc del: finite_Collect]] lemma finite_induct [case_names empty insert, induct set: finite]: - -- {* Discharging @{text "x \ F"} entails extra work. *} + -- \Discharging @{text "x \ F"} entails extra work.\ assumes "finite F" assumes "P {}" and insert: "\x F. finite F \ x \ F \ P F \ P (insert x F)" shows "P F" -using `finite F` +using \finite F\ proof induct show "P {}" by fact fix x F assume F: "finite F" and P: "P F" @@ -53,7 +53,7 @@ qed -subsubsection {* Choice principles *} +subsubsection \Choice principles\ lemma ex_new_if_finite: -- "does not depend on def of finite at all" assumes "\ finite (UNIV :: 'a set)" and "finite A" @@ -63,7 +63,7 @@ then show ?thesis by blast qed -text {* A finite choice principle. Does not need the SOME choice operator. *} +text \A finite choice principle. Does not need the SOME choice operator.\ lemma finite_set_choice: "finite A \ \x\A. \y. P x y \ \f. \x\A. P x (f x)" @@ -79,7 +79,7 @@ qed -subsubsection {* Finite sets are the images of initial segments of natural numbers *} +subsubsection \Finite sets are the images of initial segments of natural numbers\ lemma finite_imp_nat_seg_image_inj_on: assumes "finite A" @@ -130,7 +130,7 @@ assumes "finite A" shows "\f n::nat. f ` A = {i. i < n} \ inj_on f A" proof - - from finite_imp_nat_seg_image_inj_on[OF `finite A`] + from finite_imp_nat_seg_image_inj_on[OF \finite A\] obtain f and n::nat where bij: "bij_betw f {i. iFiniteness and common set operations\ lemma rev_finite_subset: "finite B \ A \ B \ finite A" @@ -215,7 +215,7 @@ shows "finite (A - B) \ finite A" proof - have "finite A \ finite((A - B) \ (A \ B))" by (simp add: Un_Diff_Int) - also have "\ \ finite (A - B)" using `finite B` by simp + also have "\ \ finite (A - B)" using \finite B\ by simp finally show ?thesis .. qed @@ -277,10 +277,10 @@ case (insert x B) then have B_A: "insert x B = f ` A" by simp then obtain y where "x = f y" and "y \ A" by blast - from B_A `x \ B` have "B = f ` A - {x}" by blast - with B_A `x \ B` `x = f y` `inj_on f A` `y \ A` have "B = f ` (A - {y})" + from B_A \x \ B\ have "B = f ` A - {x}" by blast + with B_A \x \ B\ \x = f y\ \inj_on f A\ \y \ A\ have "B = f ` (A - {y})" by (simp add: inj_on_image_set_diff Set.Diff_subset) - moreover from `inj_on f A` have "inj_on f (A - {y})" by (rule inj_on_diff) + moreover from \inj_on f A\ have "inj_on f (A - {y})" by (rule inj_on_diff) ultimately have "finite (A - {y})" by (rule insert.hyps) then show "finite A" by simp qed @@ -397,7 +397,7 @@ from assms obtain n f where "A \ B = f ` {i::nat. i < n}" by (auto simp add: finite_conv_nat_seg_image) then have "fst ` (A \ B) = fst ` f ` {i::nat. i < n}" by simp - with `B \ {}` have "A = (fst \ f) ` {i::nat. i < n}" + with \B \ {}\ have "A = (fst \ f) ` {i::nat. i < n}" by (simp add: image_comp) then have "\n f. A = f ` {i::nat. i < n}" by blast then show ?thesis @@ -411,7 +411,7 @@ from assms obtain n f where "A \ B = f ` {i::nat. i < n}" by (auto simp add: finite_conv_nat_seg_image) then have "snd ` (A \ B) = snd ` f ` {i::nat. i < n}" by simp - with `A \ {}` have "B = (snd \ f) ` {i::nat. i < n}" + with \A \ {}\ have "B = (snd \ f) ` {i::nat. i < n}" by (simp add: image_comp) then have "\n f. B = f ` {i::nat. i < n}" by blast then show ?thesis @@ -468,7 +468,7 @@ qed -subsubsection {* Further induction rules on finite sets *} +subsubsection \Further induction rules on finite sets\ lemma finite_ne_induct [case_names singleton insert, consumes 2]: assumes "finite F" and "F \ {}" @@ -487,7 +487,7 @@ assumes empty: "P {}" and insert: "\a F. finite F \ a \ A \ a \ F \ P F \ P (insert a F)" shows "P F" -using `finite F` `F \ A` +using \finite F\ \F \ A\ proof induct show "P {}" by fact next @@ -514,16 +514,16 @@ proof - fix B :: "'a set" assume "B \ A" - with `finite A` have "finite B" by (rule rev_finite_subset) - from this `B \ A` show "P (A - B)" + with \finite A\ have "finite B" by (rule rev_finite_subset) + from this \B \ A\ show "P (A - B)" proof induct case empty - from `P A` show ?case by simp + from \P A\ show ?case by simp next case (insert b B) have "P (A - B - {b})" proof (rule remove) - from `finite A` show "finite (A - B)" by induct auto + from \finite A\ show "finite (A - B)" by induct auto from insert show "b \ A - B" by simp from insert show "P (A - B)" by simp qed @@ -546,19 +546,19 @@ case (insert a A) then have "A = {a'. (f(a := c)) a' \ c}" and "f a \ c" by auto - with `finite A` have "finite {a'. (f(a := c)) a' \ c}" + with \finite A\ have "finite {a'. (f(a := c)) a' \ c}" by simp have "(f(a := c)) a = c" by simp - from insert `A = {a'. (f(a := c)) a' \ c}` have "P (f(a := c))" + from insert \A = {a'. (f(a := c)) a' \ c}\ have "P (f(a := c))" by simp - with `finite {a'. (f(a := c)) a' \ c}` `(f(a := c)) a = c` `f a \ c` have "P ((f(a := c))(a := f a))" + with \finite {a'. (f(a := c)) a' \ c}\ \(f(a := c)) a = c\ \f a \ c\ have "P ((f(a := c))(a := f a))" by (rule update) then show ?case by simp qed -subsection {* Class @{text finite} *} +subsection \Class @{text finite}\ class finite = assumes finite_UNIV: "finite (UNIV \ 'a set)" @@ -605,12 +605,12 @@ by default (simp only: UNIV_Plus_UNIV [symmetric] finite_Plus finite) -subsection {* A basic fold functional for finite sets *} +subsection \A basic fold functional for finite sets\ -text {* The intended behaviour is +text \The intended behaviour is @{text "fold f z {x\<^sub>1, ..., x\<^sub>n} = f x\<^sub>1 (\ (f x\<^sub>n z)\)"} if @{text f} is ``left-commutative'': -*} +\ locale comp_fun_commute = fixes f :: "'a \ 'b \ 'b" @@ -637,17 +637,17 @@ definition fold :: "('a \ 'b \ 'b) \ 'b \ 'a set \ 'b" where "fold f z A = (if finite A then (THE y. fold_graph f z A y) else z)" -text{*A tempting alternative for the definiens is +text\A tempting alternative for the definiens is @{term "if finite A then THE y. fold_graph f z A y else e"}. It allows the removal of finiteness assumptions from the theorems @{text fold_comm}, @{text fold_reindex} and @{text fold_distrib}. -The proofs become ugly. It is not worth the effort. (???) *} +The proofs become ugly. It is not worth the effort. (???)\ lemma finite_imp_fold_graph: "finite A \ \x. fold_graph f z A x" by (induct rule: finite_induct) auto -subsubsection{*From @{const fold_graph} to @{term fold}*} +subsubsection\From @{const fold_graph} to @{term fold}\ context comp_fun_commute begin @@ -670,7 +670,7 @@ have "f x y = f a (f x y')" unfolding y by (rule fun_left_comm) moreover have "fold_graph f z (insert x A - {a}) (f x y')" - using y' and `x \ a` and `x \ A` + using y' and \x \ a\ and \x \ A\ by (simp add: insert_Diff_if fold_graph.insertI) ultimately show ?case by fast qed @@ -685,11 +685,11 @@ "fold_graph f z A x \ fold_graph f z A y \ y = x" proof (induct arbitrary: y set: fold_graph) case (insertI x A y v) - from `fold_graph f z (insert x A) v` and `x \ A` + from \fold_graph f z (insert x A) v\ and \x \ A\ obtain y' where "v = f x y'" and "fold_graph f z A y'" by (rule fold_graph_insertE) - from `fold_graph f z A y'` have "y' = y" by (rule insertI) - with `v = f x y'` show "v = f x y" by simp + from \fold_graph f z A y'\ have "y' = y" by (rule insertI) + with \v = f x y'\ show "v = f x y" by simp qed fast lemma fold_equality: @@ -707,7 +707,7 @@ with assms show ?thesis by (simp add: fold_def) qed -text {* The base case for @{text fold}: *} +text \The base case for @{text fold}:\ lemma (in -) fold_infinite [simp]: assumes "\ finite A" @@ -718,20 +718,20 @@ "fold f z {} = z" by (auto simp add: fold_def) -text{* The various recursion equations for @{const fold}: *} +text\The various recursion equations for @{const fold}:\ lemma fold_insert [simp]: assumes "finite A" and "x \ A" shows "fold f z (insert x A) = f x (fold f z A)" proof (rule fold_equality) fix z - from `finite A` have "fold_graph f z A (fold f z A)" by (rule fold_graph_fold) - with `x \ A` have "fold_graph f z (insert x A) (f x (fold f z A))" by (rule fold_graph.insertI) + from \finite A\ have "fold_graph f z A (fold f z A)" by (rule fold_graph_fold) + with \x \ A\ have "fold_graph f z (insert x A) (f x (fold f z A))" by (rule fold_graph.insertI) then show "fold_graph f z (insert x A) (f x (fold f z A))" by simp qed declare (in -) empty_fold_graphE [rule del] fold_graph.intros [rule del] - -- {* No more proofs involve these. *} + -- \No more proofs involve these.\ lemma fold_fun_left_comm: "finite A \ f x (fold f z A) = fold f (f x z) A" @@ -750,10 +750,10 @@ assumes "finite A" and "x \ A" shows "fold f z A = f x (fold f z (A - {x}))" proof - - have A: "A = insert x (A - {x})" using `x \ A` by blast + have A: "A = insert x (A - {x})" using \x \ A\ by blast then have "fold f z A = fold f z (insert x (A - {x}))" by simp also have "\ = f x (fold f z (A - {x}))" - by (rule fold_insert) (simp add: `finite A`)+ + by (rule fold_insert) (simp add: \finite A\)+ finally show ?thesis . qed @@ -761,7 +761,7 @@ assumes "finite A" shows "fold f z (insert x A) = f x (fold f z (A - {x}))" proof - - from `finite A` have "finite (insert x A)" by auto + from \finite A\ have "finite (insert x A)" by auto moreover have "x \ insert x A" by auto ultimately have "fold f z (insert x A) = f x (fold f z (insert x A - {x}))" by (rule fold_rec) @@ -775,7 +775,7 @@ end -text{* Other properties of @{const fold}: *} +text\Other properties of @{const fold}:\ lemma fold_image: assumes "inj_on g A" @@ -794,12 +794,12 @@ case emptyI then show ?case by (auto intro: fold_graph.emptyI) next case (insertI x A r B) - from `inj_on g B` `x \ A` `insert x A = image g B` obtain x' A' where + from \inj_on g B\ \x \ A\ \insert x A = image g B\ obtain x' A' where "x' \ A'" and [simp]: "B = insert x' A'" "x = g x'" "A = g ` A'" by (rule inj_img_insertE) from insertI.prems have "fold_graph (f o g) z A' r" by (auto intro: insertI.hyps) - with `x' \ A'` have "fold_graph (f \ g) z (insert x' A') ((f \ g) x' r)" + with \x' \ A'\ have "fold_graph (f \ g) z (insert x' A') ((f \ g) x' r)" by (rule fold_graph.insertI) then show ?case by simp qed @@ -809,7 +809,7 @@ case emptyI thus ?case by (auto intro: fold_graph.emptyI) next case (insertI x A r) - from `x \ A` insertI.prems have "g x \ g ` A" by auto + from \x \ A\ insertI.prems have "g x \ g ` A" by auto moreover from insertI have "fold_graph f z (g ` A) r" by simp ultimately have "fold_graph f z (insert (g x) (g ` A)) (f (g x) r)" by (rule fold_graph.insertI) @@ -827,19 +827,19 @@ shows "fold f s A = fold g t B" proof - have "fold f s A = fold g s A" - using `finite A` cong proof (induct A) + using \finite A\ cong proof (induct A) case empty then show ?case by simp next case (insert x A) - interpret f: comp_fun_commute f by (fact `comp_fun_commute f`) - interpret g: comp_fun_commute g by (fact `comp_fun_commute g`) + interpret f: comp_fun_commute f by (fact \comp_fun_commute f\) + interpret g: comp_fun_commute g by (fact \comp_fun_commute g\) from insert show ?case by simp qed with assms show ?thesis by simp qed -text {* A simplified version for idempotent functions: *} +text \A simplified version for idempotent functions:\ locale comp_fun_idem = comp_fun_commute + assumes comp_fun_idem: "f x \ f x = f x" @@ -868,7 +868,7 @@ end -subsubsection {* Liftings to @{text comp_fun_commute} etc. *} +subsubsection \Liftings to @{text comp_fun_commute} etc.\ lemma (in comp_fun_commute) comp_comp_fun_commute: "comp_fun_commute (f \ g)" @@ -919,7 +919,7 @@ qed -subsubsection {* Expressing set operations via @{const fold} *} +subsubsection \Expressing set operations via @{const fold}\ lemma comp_fun_commute_const: "comp_fun_commute (\_. f)" @@ -951,7 +951,7 @@ shows "A \ B = fold insert B A" proof - interpret comp_fun_idem insert by (fact comp_fun_idem_insert) - from `finite A` show ?thesis by (induct A arbitrary: B) simp_all + from \finite A\ show ?thesis by (induct A arbitrary: B) simp_all qed lemma minus_fold_remove: @@ -959,7 +959,7 @@ shows "B - A = fold Set.remove B A" proof - interpret comp_fun_idem Set.remove by (fact comp_fun_idem_remove) - from `finite A` have "fold Set.remove B A = B - A" by (induct A arbitrary: B) auto + from \finite A\ have "fold Set.remove B A = B - A" by (induct A arbitrary: B) auto then show ?thesis .. qed @@ -1053,7 +1053,7 @@ shows "inf (Inf A) B = fold inf B A" proof - interpret comp_fun_idem inf by (fact comp_fun_idem_inf) - from `finite A` fold_fun_left_comm show ?thesis by (induct A arbitrary: B) + from \finite A\ fold_fun_left_comm show ?thesis by (induct A arbitrary: B) (simp_all add: inf_commute fun_eq_iff) qed @@ -1062,7 +1062,7 @@ shows "sup (Sup A) B = fold sup B A" proof - interpret comp_fun_idem sup by (fact comp_fun_idem_sup) - from `finite A` fold_fun_left_comm show ?thesis by (induct A arbitrary: B) + from \finite A\ fold_fun_left_comm show ?thesis by (induct A arbitrary: B) (simp_all add: sup_commute fun_eq_iff) qed @@ -1082,7 +1082,7 @@ proof (rule sym) interpret comp_fun_idem inf by (fact comp_fun_idem_inf) interpret comp_fun_idem "inf \ f" by (fact comp_comp_fun_idem) - from `finite A` show "?fold = ?inf" + from \finite A\ show "?fold = ?inf" by (induct A arbitrary: B) (simp_all add: inf_left_commute) qed @@ -1093,7 +1093,7 @@ proof (rule sym) interpret comp_fun_idem sup by (fact comp_fun_idem_sup) interpret comp_fun_idem "sup \ f" by (fact comp_comp_fun_idem) - from `finite A` show "?fold = ?sup" + from \finite A\ show "?fold = ?sup" by (induct A arbitrary: B) (simp_all add: sup_left_commute) qed @@ -1111,9 +1111,9 @@ end -subsection {* Locales as mini-packages for fold operations *} +subsection \Locales as mini-packages for fold operations\ -subsubsection {* The natural case *} +subsubsection \The natural case\ locale folding = fixes f :: "'a \ 'b \ 'b" @@ -1142,16 +1142,16 @@ proof - from fold_insert assms have "fold f z (insert x A) = f x (fold f z A)" by simp - with `finite A` show ?thesis by (simp add: eq_fold fun_eq_iff) + with \finite A\ show ?thesis by (simp add: eq_fold fun_eq_iff) qed lemma remove: assumes "finite A" and "x \ A" shows "F A = f x (F (A - {x}))" proof - - from `x \ A` obtain B where A: "A = insert x B" and "x \ B" + from \x \ A\ obtain B where A: "A = insert x B" and "x \ B" by (auto dest: mk_disjoint_insert) - moreover from `finite A` A have "finite B" by simp + moreover from \finite A\ A have "finite B" by simp ultimately show ?thesis by simp qed @@ -1163,7 +1163,7 @@ end -subsubsection {* With idempotency *} +subsubsection \With idempotency\ locale folding_idem = folding + assumes comp_fun_idem: "f x \ f x = f x" @@ -1180,20 +1180,20 @@ proof - from fold_insert_idem assms have "fold f z (insert x A) = f x (fold f z A)" by simp - with `finite A` show ?thesis by (simp add: eq_fold fun_eq_iff) + with \finite A\ show ?thesis by (simp add: eq_fold fun_eq_iff) qed end -subsection {* Finite cardinality *} +subsection \Finite cardinality\ -text {* +text \ The traditional definition @{prop "card A \ LEAST n. EX f. A = {f i | i. i < n}"} is ugly to work with. But now that we have @{const fold} things are easy: -*} +\ definition card :: "'a set \ nat" where "card = folding.F (\_. Suc) 0" @@ -1289,7 +1289,7 @@ then have "x \ B" by simp from insert have "A \ B - {x}" and "finite (B - {x})" by auto with insert.hyps have "card A \ card (B - {x})" by auto - with `finite A` `x \ A` `finite B` `x \ B` show ?case by simp (simp only: card.remove) + with \finite A\ \x \ A\ \finite B\ \x \ B\ show ?case by simp (simp only: card.remove) qed qed @@ -1467,24 +1467,24 @@ have "0 \ card S" by simp then have "\T \ S. card T = card S \ P T" proof (induct rule: dec_induct) - case base with `P {}` show ?case + case base with \P {}\ show ?case by (intro exI[of _ "{}"]) auto next case (step n) then obtain T where T: "T \ S" "card T = n" "P T" by auto - with `n < card S` have "T \ S" "P T" + with \n < card S\ have "T \ S" "P T" by auto with select[of T] obtain s where "s \ S" "s \ T" "P (insert s T)" by auto - with step(2) T `finite S` show ?case + with step(2) T \finite S\ show ?case by (intro exI[of _ "insert s T"]) (auto dest: finite_subset) qed - with `finite S` show "P S" + with \finite S\ show "P S" by (auto dest: card_subset_eq) qed -text{* main cardinality theorem *} +text\main cardinality theorem\ lemma card_partition [rule_format]: "finite C ==> finite (\C) --> @@ -1515,7 +1515,7 @@ qed qed -text{*The form of a finite set of given cardinality*} +text\The form of a finite set of given cardinality\ lemma card_eq_SucD: assumes "card A = Suc k" @@ -1568,7 +1568,7 @@ next case (Suc n) then guess B .. note B = this - with `\ finite A` have "A \ B" by auto + with \\ finite A\ have "A \ B" by auto with B have "B \ A" by auto hence "\x. x \ A - B" by (elim psubset_imp_ex_mem) then guess x .. note x = this @@ -1577,7 +1577,7 @@ thus "\B. finite B \ card B = Suc n \ B \ A" .. qed -subsubsection {* Cardinality of image *} +subsubsection \Cardinality of image\ lemma card_image_le: "finite A ==> card (f ` A) \ card A" by (induct rule: finite_induct) (simp_all add: le_SucI card_insert_if) @@ -1643,7 +1643,7 @@ lemma card_vimage_inj: "\ inj f; A \ range f \ \ card (f -` A) = card A" by(auto 4 3 simp add: subset_image_iff inj_vimage_image_eq intro: card_image[symmetric, OF subset_inj_on]) -subsubsection {* Pigeonhole Principles *} +subsubsection \Pigeonhole Principles\ lemma pigeonhole: "card A > card(f ` A) \ ~ inj_on f A " by (auto dest: card_image less_irrefl_nat) @@ -1660,7 +1660,7 @@ show ?case proof cases assume "finite{a:A. f a = b}" - hence "~ finite(A - {a:A. f a = b})" using `\ finite A` by simp + hence "~ finite(A - {a:A. f a = b})" using \\ finite A\ by simp also have "A - {a:A. f a = b} = {a:A. f a \ b}" by blast finally have "~ finite({a:A. f a \ b})" . from insert(3)[OF _ this] @@ -1679,20 +1679,20 @@ shows "EX b:B. ~finite{a:A. R a b}" proof - let ?F = "%a. {b:B. R a b}" - from finite_Pow_iff[THEN iffD2, OF `finite B`] + from finite_Pow_iff[THEN iffD2, OF \finite B\] have "finite(?F ` A)" by(blast intro: rev_finite_subset) from pigeonhole_infinite[where f = ?F, OF assms(1) this] obtain a0 where "a0\A" and 1: "\ finite {a\A. ?F a = ?F a0}" .. - obtain b0 where "b0 : B" and "R a0 b0" using `a0:A` assms(3) by blast + obtain b0 where "b0 : B" and "R a0 b0" using \a0:A\ assms(3) by blast { assume "finite{a:A. R a b0}" then have "finite {a\A. ?F a = ?F a0}" - using `b0 : B` `R a0 b0` by(blast intro: rev_finite_subset) + using \b0 : B\ \R a0 b0\ by(blast intro: rev_finite_subset) } - with 1 `b0 : B` show ?thesis by blast + with 1 \b0 : B\ show ?thesis by blast qed -subsubsection {* Cardinality of sums *} +subsubsection \Cardinality of sums\ lemma card_Plus: assumes "finite A" and "finite B" @@ -1708,7 +1708,7 @@ "card (A <+> B) = (if finite A \ finite B then card A + card B else 0)" by (auto simp add: card_Plus) -text {* Relates to equivalence classes. Based on a theorem of F. Kamm\"uller. *} +text \Relates to equivalence classes. Based on a theorem of F. Kamm\"uller.\ lemma dvd_partition: assumes f: "finite (\C)" and "\c\C. k dvd card c" "\c1\C. \c2\C. c1 \ c2 \ c1 \ c2 = {}" @@ -1729,7 +1729,7 @@ qed qed -subsubsection {* Relating injectivity and surjectivity *} +subsubsection \Relating injectivity and surjectivity\ lemma finite_surj_inj: assumes "finite A" "A \ f ` A" shows "inj_on f A" proof -