# HG changeset patch # User Cezary Kaliszyk # Date 1287147026 -32400 # Node ID c02078ff869181708608de625999aa6cca2518be # Parent 849578dd61274e36ebd9703ca5f6d3c5dcaca805 FSet: definition changes propagated from Nominal and more use of 'descending' tactic diff -r 849578dd6127 -r c02078ff8691 src/HOL/Quotient_Examples/FSet.thy --- a/src/HOL/Quotient_Examples/FSet.thy Fri Oct 15 21:47:45 2010 +0900 +++ b/src/HOL/Quotient_Examples/FSet.thy Fri Oct 15 21:50:26 2010 +0900 @@ -14,7 +14,7 @@ fun list_eq :: "'a list \ 'a list \ bool" (infix "\" 50) where - "list_eq xs ys = (\x. x \ set xs \ x \ set ys)" + "list_eq xs ys = (set xs = set ys)" lemma list_eq_equivp: shows "equivp list_eq" @@ -38,32 +38,25 @@ definition sub_list :: "'a list \ 'a list \ bool" where - "sub_list xs ys \ (\x. x \ set xs \ x \ set ys)" + "sub_list xs ys \ set xs \ set ys" -fun +definition fcard_raw :: "'a list \ nat" where - fcard_raw_nil: "fcard_raw [] = 0" -| fcard_raw_cons: "fcard_raw (x # xs) = (if memb x xs then fcard_raw xs else Suc (fcard_raw xs))" + "fcard_raw xs = card (set xs)" primrec finter_raw :: "'a list \ 'a list \ 'a list" where - "finter_raw [] l = []" -| "finter_raw (h # t) l = - (if memb h l then h # (finter_raw t l) else finter_raw t l)" - -primrec - delete_raw :: "'a list \ 'a \ 'a list" -where - "delete_raw [] x = []" -| "delete_raw (a # xs) x = (if (a = x) then delete_raw xs x else a # (delete_raw xs x))" + "finter_raw [] ys = []" +| "finter_raw (x # xs) ys = + (if x \ set ys then x # (finter_raw xs ys) else finter_raw xs ys)" primrec fminus_raw :: "'a list \ 'a list \ 'a list" where - "fminus_raw l [] = l" -| "fminus_raw l (h # t) = fminus_raw (delete_raw l h) t" + "fminus_raw ys [] = ys" +| "fminus_raw ys (x # xs) = fminus_raw (removeAll x ys) xs" definition rsp_fold @@ -76,7 +69,7 @@ "ffold_raw f z [] = z" | "ffold_raw f z (a # xs) = (if (rsp_fold f) then - if memb a xs then ffold_raw f z xs + if a \ set xs then ffold_raw f z xs else f a (ffold_raw f z xs) else z)" @@ -98,12 +91,9 @@ shows "Quotient (list_all2 op \) (map abs_fset) (map rep_fset)" by (fact list_quotient[OF Quotient_fset]) -lemma set_in_eq: "(\e. ((e \ xs) \ (e \ ys))) \ xs = ys" - by (rule eq_reflection) auto - lemma map_rel_cong: "b \ ba \ map f b \ map f ba" unfolding list_eq.simps - by (simp only: set_map set_in_eq) + by (simp only: set_map) lemma quotient_compose_list[quot_thm]: shows "Quotient ((list_all2 op \) OOO (op \)) @@ -160,6 +150,16 @@ qed qed + +lemma set_finter_raw[simp]: + "set (finter_raw xs ys) = set xs \ set ys" + by (induct xs) (auto simp add: memb_def) + +lemma set_fminus_raw[simp]: + "set (fminus_raw xs ys) = (set xs - set ys)" + by (induct ys arbitrary: xs) (auto) + + text {* Respectfullness *} lemma append_rsp[quot_respect]: @@ -194,6 +194,24 @@ shows "(op \ ===> op \ ===> op =) op \ op \" by auto +lemma finter_raw_rsp[quot_respect]: + shows "(op \ ===> op \ ===> op \) finter_raw finter_raw" + by simp + +lemma removeAll_rsp[quot_respect]: + shows "(op = ===> op \ ===> op \) removeAll removeAll" + by simp + +lemma fminus_raw_rsp[quot_respect]: + shows "(op \ ===> op \ ===> op \) fminus_raw fminus_raw" + by simp + +lemma fcard_raw_rsp[quot_respect]: + shows "(op \ ===> op =) fcard_raw fcard_raw" + by (simp add: fcard_raw_def) + + + lemma not_memb_nil: shows "\ memb x []" by (simp add: memb_def) @@ -202,85 +220,6 @@ shows "memb x (y # xs) = (x = y \ memb x xs)" by (induct xs) (auto simp add: memb_def) -lemma memb_finter_raw: - "memb x (finter_raw xs ys) \ memb x xs \ memb x ys" - by (induct xs) (auto simp add: not_memb_nil memb_cons_iff) - -lemma [quot_respect]: - "(op \ ===> op \ ===> op \) finter_raw finter_raw" - by (simp add: memb_def[symmetric] memb_finter_raw) - -lemma memb_delete_raw: - "memb x (delete_raw xs y) = (memb x xs \ x \ y)" - by (induct xs arbitrary: x y) (auto simp add: memb_def) - -lemma [quot_respect]: - "(op \ ===> op = ===> op \) delete_raw delete_raw" - by (simp add: memb_def[symmetric] memb_delete_raw) - -lemma fminus_raw_memb: "memb x (fminus_raw xs ys) = (memb x xs \ \ memb x ys)" - by (induct ys arbitrary: xs) - (simp_all add: not_memb_nil memb_delete_raw memb_cons_iff) - -lemma [quot_respect]: - "(op \ ===> op \ ===> op \) fminus_raw fminus_raw" - by (simp add: memb_def[symmetric] fminus_raw_memb) - -lemma fcard_raw_gt_0: - assumes a: "x \ set xs" - shows "0 < fcard_raw xs" - using a by (induct xs) (auto simp add: memb_def) - -lemma fcard_raw_delete_one: - shows "fcard_raw ([x \ xs. x \ y]) = (if memb y xs then fcard_raw xs - 1 else fcard_raw xs)" - by (induct xs) (auto dest: fcard_raw_gt_0 simp add: memb_def) - -lemma fcard_raw_rsp_aux: - assumes a: "xs \ ys" - shows "fcard_raw xs = fcard_raw ys" - using a - proof (induct xs arbitrary: ys) - case Nil - show ?case using Nil.prems by simp - next - case (Cons a xs) - have a: "a # xs \ ys" by fact - have b: "\ys. xs \ ys \ fcard_raw xs = fcard_raw ys" by fact - show ?case proof (cases "a \ set xs") - assume c: "a \ set xs" - have "\x. (x \ set xs) = (x \ set ys)" - proof (intro allI iffI) - fix x - assume "x \ set xs" - then show "x \ set ys" using a by auto - next - fix x - assume d: "x \ set ys" - have e: "(x \ set (a # xs)) = (x \ set ys)" using a by simp - show "x \ set xs" using c d e unfolding list_eq.simps by simp blast - qed - then show ?thesis using b c by (simp add: memb_def) - next - assume c: "a \ set xs" - have d: "xs \ [x\ys . x \ a] \ fcard_raw xs = fcard_raw [x\ys . x \ a]" using b by simp - have "Suc (fcard_raw xs) = fcard_raw ys" - proof (cases "a \ set ys") - assume e: "a \ set ys" - have f: "\x. (x \ set xs) = (x \ set ys \ x \ a)" using a c - by (auto simp add: fcard_raw_delete_one) - have "fcard_raw ys = Suc (fcard_raw ys - 1)" by (rule Suc_pred'[OF fcard_raw_gt_0]) (rule e) - then show ?thesis using d e f by (simp_all add: fcard_raw_delete_one memb_def) - next - case False then show ?thesis using a c d by auto - qed - then show ?thesis using a c d by (simp add: memb_def) - qed -qed - -lemma fcard_raw_rsp[quot_respect]: - shows "(op \ ===> op =) fcard_raw fcard_raw" - by (simp add: fcard_raw_rsp_aux) - lemma memb_absorb: shows "memb x xs \ x # xs \ xs" by (induct xs) (auto simp add: memb_def) @@ -289,53 +228,35 @@ "(\x. \ memb x xs) = (xs \ [])" by (simp add: memb_def) -lemma not_memb_delete_raw_ident: - shows "\ memb x xs \ delete_raw xs x = xs" - by (induct xs) (auto simp add: memb_def) lemma memb_commute_ffold_raw: - "rsp_fold f \ memb h b \ ffold_raw f z b = f h (ffold_raw f z (delete_raw b h))" + "rsp_fold f \ h \ set b \ ffold_raw f z b = f h (ffold_raw f z (removeAll h b))" apply (induct b) - apply (simp_all add: not_memb_nil) - apply (auto) - apply (simp_all add: memb_delete_raw not_memb_delete_raw_ident rsp_fold_def memb_cons_iff) + apply (auto simp add: rsp_fold_def) done lemma ffold_raw_rsp_pre: - "\e. memb e a = memb e b \ ffold_raw f z a = ffold_raw f z b" + "set a = set b \ ffold_raw f z a = ffold_raw f z b" apply (induct a arbitrary: b) - apply (simp add: memb_absorb memb_def none_memb_nil) apply (simp) + apply (simp (no_asm_use)) apply (rule conjI) apply (rule_tac [!] impI) apply (rule_tac [!] conjI) apply (rule_tac [!] impI) - apply (subgoal_tac "\e. memb e a2 = memb e b") - apply (simp) - apply (simp add: memb_cons_iff memb_def) - apply (auto)[1] - apply (drule_tac x="e" in spec) - apply (blast) - apply (case_tac b) - apply (simp_all) - apply (subgoal_tac "ffold_raw f z b = f a1 (ffold_raw f z (delete_raw b a1))") - apply (simp only:) - apply (rule_tac f="f a1" in arg_cong) - apply (subgoal_tac "\e. memb e a2 = memb e (delete_raw b a1)") - apply (simp) - apply (simp add: memb_delete_raw) - apply (auto simp add: memb_cons_iff)[1] - apply (erule memb_commute_ffold_raw) - apply (drule_tac x="a1" in spec) - apply (simp add: memb_cons_iff) - apply (simp add: memb_cons_iff) - apply (case_tac b) - apply (simp_all) - done + apply (metis insert_absorb) + apply (metis List.insert_def List.set.simps(2) List.set_insert ffold_raw.simps(2)) + apply (metis Diff_insert_absorb insertI1 memb_commute_ffold_raw set_removeAll) + apply(drule_tac x="removeAll a1 b" in meta_spec) + apply(auto) + apply(drule meta_mp) + apply(blast) + by (metis List.set.simps(2) emptyE ffold_raw.simps(2) in_listsp_conv_set listsp.simps mem_def) lemma ffold_raw_rsp[quot_respect]: shows "(op = ===> op = ===> op \ ===> op =) ffold_raw ffold_raw" - by (simp add: memb_def[symmetric] ffold_raw_rsp_pre) + unfolding fun_rel_def + by(auto intro: ffold_raw_rsp_pre) lemma concat_rsp_pre: assumes a: "list_all2 op \ x x'" @@ -359,9 +280,11 @@ assume a: "list_all2 op \ a ba" assume b: "ba \ bb" assume c: "list_all2 op \ bb b" - have "\x. (\xa\set a. x \ set xa) = (\xa\set b. x \ set xa)" proof + have "\x. (\xa\set a. x \ set xa) = (\xa\set b. x \ set xa)" + proof fix x - show "(\xa\set a. x \ set xa) = (\xa\set b. x \ set xa)" proof + show "(\xa\set a. x \ set xa) = (\xa\set b. x \ set xa)" + proof assume d: "\xa\set a. x \ set xa" show "\xa\set b. x \ set xa" by (rule concat_rsp_pre[OF a b c d]) next @@ -372,7 +295,7 @@ show "\xa\set a. x \ set xa" by (rule concat_rsp_pre[OF c' b' a' e]) qed qed - then show "concat a \ concat b" by simp + then show "concat a \ concat b" by auto qed lemma [quot_respect]: @@ -384,9 +307,7 @@ lemma append_inter_distrib: "x @ (finter_raw y z) \ finter_raw (x @ y) (x @ z)" apply (induct x) - apply (simp_all add: memb_def) - apply (simp add: memb_def[symmetric] memb_finter_raw) - apply (auto simp add: memb_def) + apply (auto) done instantiation fset :: (type) "{bounded_lattice_bot, distrib_lattice, minus}" @@ -416,7 +337,7 @@ "xs < ys \ xs \ ys \ xs \ (ys::'a fset)" abbreviation - f_subset :: "'a fset \ 'a fset \ bool" (infix "|\|" 50) + fsubset :: "'a fset \ 'a fset \ bool" (infix "|\|" 50) where "xs |\| ys \ xs < ys" @@ -455,10 +376,10 @@ show "{||} |\| x" by (descending) (simp add: sub_list_def) show "x |\| x |\| y" by (descending) (simp add: sub_list_def) show "y |\| x |\| y" by (descending) (simp add: sub_list_def) - show "x |\| y |\| x" - by (descending) (simp add: sub_list_def memb_def[symmetric] memb_finter_raw) + show "x |\| y |\| x" + by (descending) (simp add: sub_list_def memb_def[symmetric]) show "x |\| y |\| y" - by (descending) (simp add: sub_list_def memb_def[symmetric] memb_finter_raw) + by (descending) (simp add: sub_list_def memb_def[symmetric]) show "x |\| (y |\| z) = x |\| y |\| (x |\| z)" by (descending) (rule append_inter_distrib) next @@ -484,7 +405,7 @@ assume a: "x |\| y" assume b: "x |\| z" show "x |\| y |\| z" using a b - by (descending) (simp add: sub_list_def memb_def[symmetric] memb_finter_raw) + by (descending) (simp add: sub_list_def memb_def[symmetric]) qed end @@ -525,11 +446,11 @@ map quotient_definition - "fdelete :: 'a fset \ 'a \ 'a fset" - is "delete_raw" + "fdelete :: 'a \ 'a fset \ 'a fset" + is removeAll quotient_definition - "fset_to_set :: 'a fset \ 'a set" + "fset :: 'a fset \ 'a set" is "set" quotient_definition @@ -557,7 +478,6 @@ lemma [quot_respect]: shows "(op \ ===> list_all2 op \ OOO op \ ===> list_all2 op \ OOO op \) Cons Cons" apply auto - apply (simp add: set_in_eq) apply (rule_tac b="x # b" in pred_compI) apply auto apply (rule_tac b="x # ba" in pred_compI) @@ -651,52 +571,22 @@ lemma singleton_list_eq: shows "[x] \ [y] \ x = y" - by (simp add: id_simps) auto + by (simp) lemma sub_list_cons: "sub_list (x # xs) ys = (memb x ys \ sub_list xs ys)" by (auto simp add: memb_def sub_list_def) -lemma fminus_raw_red: "fminus_raw (x # xs) ys = (if memb x ys then fminus_raw xs ys else x # (fminus_raw xs ys))" - by (induct ys arbitrary: xs x) - (simp_all add: not_memb_nil memb_delete_raw memb_cons_iff) +lemma fminus_raw_red: + "fminus_raw (x # xs) ys = (if x \ set ys then fminus_raw xs ys else x # (fminus_raw xs ys))" + by (induct ys arbitrary: xs x) (simp_all) text {* Cardinality of finite sets *} lemma fcard_raw_0: shows "fcard_raw xs = 0 \ xs \ []" - by (induct xs) (auto simp add: memb_def) - -lemma fcard_raw_not_memb: - shows "\ memb x xs \ fcard_raw (x # xs) = Suc (fcard_raw xs)" - by auto - -lemma fcard_raw_suc: - assumes a: "fcard_raw xs = Suc n" - shows "\x ys. \ (memb x ys) \ xs \ (x # ys) \ fcard_raw ys = n" - using a - by (induct xs) (auto simp add: memb_def split: if_splits) - -lemma singleton_fcard_1: - shows "set xs = {x} \ fcard_raw xs = 1" - by (induct xs) (auto simp add: memb_def subset_insert) - -lemma fcard_raw_1: - shows "fcard_raw xs = 1 \ (\x. xs \ [x])" - apply (auto dest!: fcard_raw_suc) - apply (simp add: fcard_raw_0) - apply (rule_tac x="x" in exI) - apply simp - apply (subgoal_tac "set xs = {x}") - apply (drule singleton_fcard_1) - apply auto - done - -lemma fcard_raw_suc_memb: - assumes a: "fcard_raw A = Suc n" - shows "\a. memb a A" - using a - by (induct A) (auto simp add: memb_def) + unfolding fcard_raw_def + by (induct xs) (auto) lemma memb_card_not_0: assumes a: "memb a A" @@ -752,21 +642,18 @@ section {* deletion *} -lemma memb_delete_raw_ident: - shows "\ memb x (delete_raw xs x)" + +lemma fset_raw_removeAll_cases: + "xs = [] \ (\x. memb x xs \ xs \ x # removeAll x xs)" by (induct xs) (auto simp add: memb_def) -lemma fset_raw_delete_raw_cases: - "xs = [] \ (\x. memb x xs \ xs \ x # delete_raw xs x)" - by (induct xs) (auto simp add: memb_def) - -lemma fdelete_raw_filter: - "delete_raw xs y = [x \ xs. x \ y]" +lemma fremoveAll_filter: + "removeAll y xs = [x \ xs. x \ y]" by (induct xs) simp_all lemma fcard_raw_delete: - "fcard_raw (delete_raw xs y) = (if memb y xs then fcard_raw xs - 1 else fcard_raw xs)" - by (simp add: fdelete_raw_filter fcard_raw_delete_one) + "fcard_raw (removeAll y xs) = (if memb y xs then fcard_raw xs - 1 else fcard_raw xs)" + by (auto simp add: fcard_raw_def memb_def) lemma set_cong: shows "(x \ y) = (set x = set y)" @@ -794,7 +681,7 @@ by (induct xs) (auto intro: list_eq2.intros) lemma cons_delete_list_eq2: - shows "list_eq2 (a # (delete_raw A a)) (if memb a A then A else a # A)" + shows "list_eq2 (a # (removeAll a A)) (if memb a A then A else a # A)" apply (induct A) apply (simp add: memb_def list_eq2_refl) apply (case_tac "memb a (aa # A)") @@ -805,19 +692,15 @@ apply (auto simp add: memb_def)[2] apply (metis list_eq2.intros(3) list_eq2.intros(4) list_eq2.intros(5) list_eq2.intros(6)) apply (metis list_eq2.intros(1) list_eq2.intros(5) list_eq2.intros(6)) - apply (auto simp add: list_eq2_refl not_memb_delete_raw_ident) + apply (auto simp add: list_eq2_refl memb_def) done lemma memb_delete_list_eq2: assumes a: "memb e r" - shows "list_eq2 (e # delete_raw r e) r" + shows "list_eq2 (e # removeAll e r) r" using a cons_delete_list_eq2[of e r] by simp -lemma delete_raw_rsp: - "xs \ ys \ delete_raw xs x \ delete_raw ys x" - by (simp add: memb_def[symmetric] memb_delete_raw) - lemma list_eq2_equiv: "(l \ r) \ (list_eq2 l r)" proof @@ -839,58 +722,27 @@ case (Suc m) have b: "l \ r" by fact have d: "fcard_raw l = Suc m" by fact - then have "\a. memb a l" by (rule fcard_raw_suc_memb) + then have "\a. memb a l" + apply(simp add: fcard_raw_def memb_def) + apply(drule card_eq_SucD) + apply(blast) + done then obtain a where e: "memb a l" by auto - then have e': "memb a r" using list_eq.simps[simplified memb_def[symmetric], of l r] b by auto - have f: "fcard_raw (delete_raw l a) = m" using fcard_raw_delete[of l a] e d by simp - have g: "delete_raw l a \ delete_raw r a" using delete_raw_rsp[OF b] by simp - have "list_eq2 (delete_raw l a) (delete_raw r a)" by (rule Suc.hyps[OF f g]) - then have h: "list_eq2 (a # delete_raw l a) (a # delete_raw r a)" by (rule list_eq2.intros(5)) - have i: "list_eq2 l (a # delete_raw l a)" + then have e': "memb a r" using list_eq.simps[simplified memb_def[symmetric], of l r] b + unfolding memb_def by auto + have f: "fcard_raw (removeAll a l) = m" using fcard_raw_delete[of a l] e d by simp + have g: "removeAll a l \ removeAll a r" using removeAll_rsp b by simp + have "list_eq2 (removeAll a l) (removeAll a r)" by (rule Suc.hyps[OF f g]) + then have h: "list_eq2 (a # removeAll a l) (a # removeAll a r)" by (rule list_eq2.intros(5)) + have i: "list_eq2 l (a # removeAll a l)" by (rule list_eq2.intros(3)[OF memb_delete_list_eq2[OF e]]) - have "list_eq2 l (a # delete_raw r a)" by (rule list_eq2.intros(6)[OF i h]) + have "list_eq2 l (a # removeAll a r)" by (rule list_eq2.intros(6)[OF i h]) then show ?case using list_eq2.intros(6)[OF _ memb_delete_list_eq2[OF e']] by simp qed } then show "l \ r \ list_eq2 l r" by blast qed -text {* Set *} - -lemma sub_list_set: "sub_list xs ys = (set xs \ set ys)" - unfolding sub_list_def by auto - -lemma sub_list_neq_set: "(sub_list xs ys \ \ list_eq xs ys) = (set xs \ set ys)" - by (auto simp add: sub_list_set) - -lemma fcard_raw_set: "fcard_raw xs = card (set xs)" - by (induct xs) (auto simp add: insert_absorb memb_def card_insert_disjoint finite_set) - -lemma memb_set: "memb x xs = (x \ set xs)" - by (simp only: memb_def) - -lemma filter_set: "set (filter P xs) = P \ (set xs)" - by (induct xs, simp) - (metis Int_insert_right_if0 Int_insert_right_if1 List.set.simps(2) filter.simps(2) mem_def) - -lemma delete_raw_set: "set (delete_raw xs x) = set xs - {x}" - by (induct xs) auto - -lemma inter_raw_set: "set (finter_raw xs ys) = set xs \ set ys" - by (induct xs) (simp_all add: memb_def) - -lemma fminus_raw_set: "set (fminus_raw xs ys) = set xs - set ys" - by (induct ys arbitrary: xs) - (simp_all add: fminus_raw.simps delete_raw_set, blast) - -text {* Raw theorems of ffilter *} - -lemma sub_list_filter: "sub_list (filter P xs) (filter Q xs) = (\ x. memb x xs \ P x \ Q x)" -unfolding sub_list_def memb_def by auto - -lemma list_eq_filter: "list_eq (filter P xs) (filter Q xs) = (\x. memb x xs \ P x = Q x)" -unfolding memb_def by auto - text {* Lifted theorems *} lemma not_fin_fnil: "x |\| {||}" @@ -927,16 +779,15 @@ by (descending) (auto) -text {* fset_to_set *} +text {* fset *} -lemma fset_to_set_simps [simp]: - fixes h::"'a" - shows "fset_to_set {||} = ({} :: 'a set)" - and "fset_to_set (finsert h t) = insert h (fset_to_set t)" +lemma fset_simps[simp]: + "fset {||} = ({} :: 'a set)" + "fset (finsert (h :: 'a) t) = insert h (fset t)" by (lifting set.simps) -lemma in_fset_to_set: - "x \ fset_to_set S \ x |\| S" +lemma in_fset: + "x \ fset S \ x |\| S" by (lifting memb_def[symmetric]) lemma none_fin_fempty: @@ -944,47 +795,62 @@ by (lifting none_memb_nil) lemma fset_cong: - "S = T \ fset_to_set S = fset_to_set T" + "S = T \ fset S = fset T" by (lifting set_cong) + text {* fcard *} -lemma fcard_fempty [simp]: - shows "fcard {||} = 0" - by (descending) (simp) - lemma fcard_finsert_if [simp]: shows "fcard (finsert x S) = (if x |\| S then fcard S else Suc (fcard S))" - by (descending) (simp) + by (descending) (auto simp add: fcard_raw_def memb_def insert_absorb) -lemma fcard_0: - "fcard S = 0 \ S = {||}" - by (lifting fcard_raw_0) +lemma fcard_0[simp]: + shows "fcard S = 0 \ S = {||}" + by (descending) (simp add: fcard_raw_def) + +lemma fcard_fempty[simp]: + shows "fcard {||} = 0" + by (simp add: fcard_0) lemma fcard_1: shows "fcard S = 1 \ (\x. S = {|x|})" - by (lifting fcard_raw_1) + by (descending) (auto simp add: fcard_raw_def card_Suc_eq) lemma fcard_gt_0: - shows "x \ fset_to_set S \ 0 < fcard S" - by (lifting fcard_raw_gt_0) - + shows "x \ fset S \ 0 < fcard S" + by (descending) (auto simp add: fcard_raw_def card_gt_0_iff) + lemma fcard_not_fin: shows "(x |\| S) = (fcard (finsert x S) = Suc (fcard S))" - by (lifting fcard_raw_not_memb) + by (descending) (auto simp add: memb_def fcard_raw_def insert_absorb) lemma fcard_suc: "fcard S = Suc n \ \x T. x |\| T \ S = finsert x T \ fcard T = n" - by (lifting fcard_raw_suc) + apply descending + apply(simp add: fcard_raw_def memb_def) + apply(drule card_eq_SucD) + apply(auto) + apply(rule_tac x="b" in exI) + apply(rule_tac x="removeAll b S" in exI) + apply(auto) + done lemma fcard_delete: - "fcard (fdelete S y) = (if y |\| S then fcard S - 1 else fcard S)" + "fcard (fdelete y S) = (if y |\| S then fcard S - 1 else fcard S)" by (lifting fcard_raw_delete) -lemma fcard_suc_memb: "fcard A = Suc n \ \a. a |\| A" - by (lifting fcard_raw_suc_memb) +lemma fcard_suc_memb: + shows "fcard A = Suc n \ \a. a |\| A" + apply(descending) + apply(simp add: fcard_raw_def memb_def) + apply(drule card_eq_SucD) + apply(auto) + done -lemma fin_fcard_not_0: "a |\| A \ fcard A \ 0" - by (lifting memb_card_not_0) +lemma fin_fcard_not_0: + shows "a |\| A \ fcard A \ 0" + by (descending) (auto simp add: fcard_raw_def memb_def) + text {* funion *} @@ -1070,7 +936,7 @@ by (lifting map.simps) lemma fmap_set_image: - "fset_to_set (fmap f S) = f ` (fset_to_set S)" + "fset (fmap f S) = f ` (fset S)" by (induct S) simp_all lemma inj_fmap_eq_iff: @@ -1085,103 +951,107 @@ shows "x |\| S |\| T \ x |\| S \ x |\| T" by (lifting memb_append) -text {* to_set *} + +section {* fset *} lemma fin_set: - shows "x |\| xs \ x \ fset_to_set xs" - by (lifting memb_set) + shows "x |\| xs \ x \ fset xs" + by (lifting memb_def) lemma fnotin_set: - shows "x |\| xs \ x \ fset_to_set xs" + shows "x |\| xs \ x \ fset xs" by (simp add: fin_set) lemma fcard_set: - shows "fcard xs = card (fset_to_set xs)" - by (lifting fcard_raw_set) + shows "fcard xs = card (fset xs)" + by (lifting fcard_raw_def) lemma fsubseteq_set: - shows "xs |\| ys \ fset_to_set xs \ fset_to_set ys" - by (lifting sub_list_set) + shows "xs |\| ys \ fset xs \ fset ys" + by (lifting sub_list_def) lemma fsubset_set: - shows "xs |\| ys \ fset_to_set xs \ fset_to_set ys" - unfolding less_fset_def by (lifting sub_list_neq_set) + shows "xs |\| ys \ fset xs \ fset ys" + unfolding less_fset_def + by (descending) (auto simp add: sub_list_def) -lemma ffilter_set: - shows "fset_to_set (ffilter P xs) = P \ fset_to_set xs" - by (lifting filter_set) +lemma ffilter_set [simp]: + shows "fset (ffilter P xs) = P \ fset xs" + by (descending) (auto simp add: mem_def) -lemma fdelete_set: - shows "fset_to_set (fdelete xs x) = fset_to_set xs - {x}" - by (lifting delete_raw_set) +lemma fdelete_set [simp]: + shows "fset (fdelete x xs) = fset xs - {x}" + by (lifting set_removeAll) -lemma finter_set: - shows "fset_to_set (xs |\| ys) = fset_to_set xs \ fset_to_set ys" - by (lifting inter_raw_set) +lemma finter_set [simp]: + shows "fset (xs |\| ys) = fset xs \ fset ys" + by (lifting set_finter_raw) -lemma funion_set: - shows "fset_to_set (xs |\| ys) = fset_to_set xs \ fset_to_set ys" +lemma funion_set [simp]: + shows "fset (xs |\| ys) = fset xs \ fset ys" by (lifting set_append) -lemma fminus_set: - shows "fset_to_set (xs - ys) = fset_to_set xs - fset_to_set ys" - by (lifting fminus_raw_set) +lemma fminus_set [simp]: + shows "fset (xs - ys) = fset xs - fset ys" + by (lifting set_fminus_raw) lemmas fset_to_set_trans = fin_set fnotin_set fcard_set fsubseteq_set fsubset_set - finter_set funion_set ffilter_set fset_to_set_simps + finter_set funion_set ffilter_set fset_simps fset_cong fdelete_set fmap_set_image fminus_set text {* ffold *} -lemma ffold_nil: "ffold f z {||} = z" +lemma ffold_nil: + shows "ffold f z {||} = z" by (lifting ffold_raw.simps(1)[where 'a="'b" and 'b="'a"]) lemma ffold_finsert: "ffold f z (finsert a A) = (if rsp_fold f then if a |\| A then ffold f z A else f a (ffold f z A) else z)" - by (lifting ffold_raw.simps(2)[where 'a="'b" and 'b="'a"]) + by (descending) (simp add: memb_def) lemma fin_commute_ffold: - "\rsp_fold f; h |\| b\ \ ffold f z b = f h (ffold f z (fdelete b h))" - by (lifting memb_commute_ffold_raw) + "\rsp_fold f; h |\| b\ \ ffold f z b = f h (ffold f z (fdelete h b))" + by (descending) (simp add: memb_def memb_commute_ffold_raw) + text {* fdelete *} lemma fin_fdelete: - shows "x |\| fdelete S y \ x |\| S \ x \ y" - by (lifting memb_delete_raw) + shows "x |\| fdelete y S \ x |\| S \ x \ y" + by (descending) (simp add: memb_def) -lemma fin_fdelete_ident: - shows "x |\| fdelete S x" - by (lifting memb_delete_raw_ident) +lemma fnotin_fdelete: + shows "x |\| fdelete x S" + by (descending) (simp add: memb_def) -lemma not_memb_fdelete_ident: - shows "x |\| S \ fdelete S x = S" - by (lifting not_memb_delete_raw_ident) +lemma fnotin_fdelete_ident: + shows "x |\| S \ fdelete x S = S" + by (descending) (simp add: memb_def) lemma fset_fdelete_cases: - shows "S = {||} \ (\x. x |\| S \ S = finsert x (fdelete S x))" - by (lifting fset_raw_delete_raw_cases) + shows "S = {||} \ (\x. x |\| S \ S = finsert x (fdelete x S))" + by (lifting fset_raw_removeAll_cases) text {* finite intersection *} -lemma finter_empty_l: +lemma finter_empty_l: shows "{||} |\| S = {||}" by simp -lemma finter_empty_r: +lemma finter_empty_r: shows "S |\| {||} = {||}" by simp lemma finter_finsert: - "finsert x S |\| T = (if x |\| T then finsert x (S |\| T) else S |\| T)" - by (lifting finter_raw.simps(2)) + shows "finsert x S |\| T = (if x |\| T then finsert x (S |\| T) else S |\| T)" + by (descending) (simp add: memb_def) lemma fin_finter: - "x |\| (S |\| T) \ x |\| S \ x |\| T" - by (lifting memb_finter_raw) + shows "x |\| (S |\| T) \ x |\| S \ x |\| T" + by (descending) (simp add: memb_def) lemma fsubset_finsert: shows "finsert x xs |\| ys \ x |\| ys \ xs |\| ys" @@ -1189,20 +1059,19 @@ lemma shows "xs |\| ys \ \x. x |\| xs \ x |\| ys" - by (lifting sub_list_def[simplified memb_def[symmetric]]) + by (descending) (auto simp add: sub_list_def memb_def) lemma fsubset_fin: shows "xs |\| ys = (\x. x |\| xs \ x |\| ys)" -by (rule meta_eq_to_obj_eq) - (lifting sub_list_def[simplified memb_def[symmetric]]) + by (descending) (auto simp add: sub_list_def memb_def) lemma fminus_fin: shows "x |\| xs - ys \ x |\| xs \ x |\| ys" - by (lifting fminus_raw_memb) + by (descending) (simp add: memb_def) lemma fminus_red: shows "finsert x xs - ys = (if x |\| ys then xs - ys else finsert x (xs - ys))" - by (lifting fminus_raw_red) + by (descending) (auto simp add: memb_def) lemma fminus_red_fin [simp]: shows "x |\| ys \ finsert x xs - ys = xs - ys" @@ -1212,7 +1081,7 @@ shows "x |\| ys \ finsert x xs - ys = finsert x (xs - ys)" by (simp add: fminus_red) -lemma expand_fset_eq: +lemma fset_eq_iff: shows "S = T \ (\x. (x |\| S) = (x |\| T))" by (descending) (auto simp add: memb_def) @@ -1275,7 +1144,7 @@ text {* finiteness for finite sets holds *} lemma finite_fset [simp]: - shows "finite (fset_to_set S)" + shows "finite (fset S)" by (induct S) auto lemma fset_choice: @@ -1283,16 +1152,14 @@ unfolding fset_to_set_trans by (rule finite_set_choice[simplified Ball_def, OF finite_fset]) -lemma fsubseteq_fnil: +lemma fsubseteq_fempty: shows "xs |\| {||} \ xs = {||}" - unfolding fset_to_set_trans - by (rule subset_empty) + by (metis finter_empty_r le_iff_inf) lemma not_fsubset_fnil: shows "\ xs |\| {||}" - unfolding fset_to_set_trans - by (rule not_psubset_empty) - + by (metis fset_simps(1) fsubset_set not_psubset_empty) + lemma fcard_mono: shows "xs |\| ys \ fcard xs \ fcard ys" unfolding fset_to_set_trans @@ -1300,8 +1167,8 @@ lemma fcard_fseteq: shows "xs |\| ys \ fcard ys \ fcard xs \ xs = ys" - unfolding fset_to_set_trans - by (rule card_seteq[OF finite_fset]) + unfolding fcard_set fsubseteq_set + by (simp add: card_seteq[OF finite_fset] fset_cong) lemma psubset_fcard_mono: shows "xs |\| ys \ fcard xs < fcard ys" @@ -1319,17 +1186,17 @@ by (rule card_Un_disjoint[OF finite_fset finite_fset]) lemma fcard_delete1_less: - shows "x |\| xs \ fcard (fdelete xs x) < fcard xs" + shows "x |\| xs \ fcard (fdelete x xs) < fcard xs" unfolding fset_to_set_trans by (rule card_Diff1_less[OF finite_fset]) lemma fcard_delete2_less: - shows "x |\| xs \ y |\| xs \ fcard (fdelete (fdelete xs x) y) < fcard xs" + shows "x |\| xs \ y |\| xs \ fcard (fdelete y (fdelete x xs)) < fcard xs" unfolding fset_to_set_trans by (rule card_Diff2_less[OF finite_fset]) lemma fcard_delete1_le: - shows "fcard (fdelete xs x) \ fcard xs" + shows "fcard (fdelete x xs) \ fcard xs" unfolding fset_to_set_trans by (rule card_Diff1_le[OF finite_fset]) @@ -1353,14 +1220,16 @@ unfolding fset_to_set_trans by blast -lemma fin_mdef: "x |\| F \ x |\| (F - {|x|}) \ F = finsert x (F - {|x|})" +lemma fin_mdef: + "x |\| F \ x |\| (F - {|x|}) \ F = finsert x (F - {|x|})" unfolding fset_to_set_trans by blast lemma fcard_fminus_finsert[simp]: assumes "a |\| A" and "a |\| B" shows "fcard(A - finsert a B) = fcard(A - B) - 1" - using assms unfolding fset_to_set_trans + using assms + unfolding fset_to_set_trans by (rule card_Diff_insert[OF finite_fset]) lemma fcard_fminus_fsubset: @@ -1370,7 +1239,7 @@ by (rule card_Diff_subset[OF finite_fset]) lemma fcard_fminus_subset_finter: - "fcard (A - B) = fcard A - fcard (A |\| B)" + shows "fcard (A - B) = fcard A - fcard (A |\| B)" unfolding fset_to_set_trans by (rule card_Diff_subset_Int) (fold finter_set, rule finite_fset)