diff -r e903c32ec24f -r 693562f03eee Nominal/FSet.thy --- a/Nominal/FSet.thy Wed Oct 13 22:55:58 2010 +0100 +++ b/Nominal/FSet.thy Thu Oct 14 04:14:22 2010 +0100 @@ -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,34 +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 @@ -78,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)" @@ -100,12 +91,14 @@ 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 \)) @@ -165,13 +158,14 @@ text {* Respectfullness *} lemma append_rsp[quot_respect]: - shows "(op \ ===> op \ ===> op \) op @ op @" - apply(simp del: list_eq.simps) - by auto + shows "(op \ ===> op \ ===> op \) append append" + by (simp) +(* lemma append_rsp_unfolded: "\x \ y; v \ w\ \ x @ v \ y @ w" by auto +*) lemma [quot_respect]: shows "(op \ ===> op \ ===> op =) sub_list sub_list" @@ -186,7 +180,7 @@ by simp lemma cons_rsp[quot_respect]: - shows "(op = ===> op \ ===> op \) op # op #" + shows "(op = ===> op \ ===> op \) Cons Cons" by simp lemma map_rsp[quot_respect]: @@ -209,84 +203,35 @@ 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 set_finter_raw[simp]: + "set (finter_raw xs ys) = set xs \ set ys" + by (induct xs) (auto simp add: memb_def) lemma [quot_respect]: - "(op \ ===> op \ ===> op \) fminus_raw fminus_raw" - by (simp add: memb_def[symmetric] fminus_raw_memb) + shows "(op \ ===> op \ ===> op \) finter_raw finter_raw" + by (simp) -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 memb_removeAll: + "memb x (removeAll y xs) \ memb x xs \ x \ y" + by (induct xs arbitrary: x y) (auto 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 [quot_respect]: + shows "(op = ===> op \ ===> op \) removeAll removeAll" + by (simp) + +lemma set_fminus_raw[simp]: + "set (fminus_raw xs ys) = (set xs - set ys)" + by (induct ys arbitrary: xs) (auto) + +lemma [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_rsp_aux) + by (simp add: fcard_raw_def) lemma memb_absorb: shows "memb x xs \ x # xs \ xs" @@ -296,53 +241,39 @@ "(\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" +lemma not_memb_removeAll_ident: + shows "\ memb x xs \ removeAll x xs = 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 [quot_respect]: - "(op = ===> op = ===> op \ ===> op =) ffold_raw ffold_raw" - by (simp add: memb_def[symmetric] ffold_raw_rsp_pre) + shows "(op = ===> op = ===> op \ ===> op =) ffold_raw ffold_raw" + unfolding fun_rel_def + apply(auto intro: ffold_raw_rsp_pre) + done lemma concat_rsp_pre: assumes a: "list_all2 op \ x x'" @@ -366,9 +297,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 @@ -379,11 +312,10 @@ 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 concat_rsp_unfolded: "\list_all2 op \ a ba; ba \ bb; list_all2 op \ bb b\ \ concat a \ concat b" proof - @@ -404,11 +336,11 @@ 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]: - "((op =) ===> op \ ===> op \) filter filter" + shows "((op =) ===> op \ ===> op \) filter filter" by auto text {* Distributive lattice with bot *} @@ -439,11 +371,11 @@ lemma sub_list_inter_left: shows "sub_list (finter_raw x y) x" - by (simp add: sub_list_def memb_def[symmetric] memb_finter_raw) + by (simp add: sub_list_def) lemma sub_list_inter_right: shows "sub_list (finter_raw x y) y" - by (simp add: sub_list_def memb_def[symmetric] memb_finter_raw) + by (simp add: sub_list_def) lemma sub_list_list_eq: "sub_list x y \ sub_list y x \ list_eq x y" @@ -455,14 +387,12 @@ lemma sub_list_inter: "sub_list x y \ sub_list x z \ sub_list x (finter_raw y z)" - by (simp add: sub_list_def memb_def[symmetric] memb_finter_raw) + by (simp add: sub_list_def) 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}" @@ -487,44 +417,45 @@ "xs |\| ys \ xs \ ys" definition - less_fset: - "(xs :: 'a fset) < ys \ xs \ ys \ xs \ ys" + less_fset :: "'a fset \ 'a fset \ bool" +where + "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" quotient_definition - "sup \ ('a fset \ 'a fset \ 'a fset)" + "sup :: 'a fset \ 'a fset \ 'a fset" is - "(op @) \ ('a list \ 'a list \ 'a list)" + "append :: 'a list \ 'a list \ 'a list" abbreviation funion (infixl "|\|" 65) where - "xs |\| ys \ sup (xs :: 'a fset) ys" + "xs |\| ys \ sup xs (ys::'a fset)" quotient_definition - "inf \ ('a fset \ 'a fset \ 'a fset)" + "inf :: 'a fset \ 'a fset \ 'a fset" is - "finter_raw \ ('a list \ 'a list \ 'a list)" + "finter_raw :: 'a list \ 'a list \ 'a list" abbreviation finter (infixl "|\|" 65) where - "xs |\| ys \ inf (xs :: 'a fset) ys" + "xs |\| ys \ inf xs (ys::'a fset)" quotient_definition - "minus \ ('a fset \ 'a fset \ 'a fset)" + "minus :: 'a fset \ 'a fset \ 'a fset" is - "fminus_raw \ ('a list \ 'a list \ 'a list)" + "fminus_raw :: 'a list \ 'a list \ 'a list" instance proof fix x y z :: "'a fset" show "(x |\| y) = (x |\| y \ \ y |\| x)" - unfolding less_fset by (lifting sub_list_not_eq) + unfolding less_fset_def by (lifting sub_list_not_eq) show "x |\| x" by (lifting sub_list_refl) show "{||} |\| x" by (lifting sub_list_empty) show "x |\| x |\| y" by (lifting sub_list_append_left) @@ -560,7 +491,7 @@ quotient_definition "finsert :: 'a \ 'a fset \ 'a fset" -is "op #" +is "Cons" syntax "@Finset" :: "args => 'a fset" ("{|(_)|}") @@ -583,20 +514,18 @@ quotient_definition "fcard :: 'a fset \ nat" -is - "fcard_raw" + is fcard_raw quotient_definition "fmap :: ('a \ 'b) \ 'a fset \ 'b fset" -is - "map" + is 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 @@ -622,9 +551,8 @@ by simp lemma [quot_respect]: - "(op \ ===> list_all2 op \ OOO op \ ===> list_all2 op \ OOO op \) op # op #" + 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) @@ -723,53 +651,25 @@ lemma singleton_list_eq: shows "[x] \ [y] \ x = y" - by (simp add:) 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 *} +(* used in memb_card_not_0 *) 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_ifs) - -lemma singleton_fcard_1: - shows "set xs = {x} \ fcard_raw xs = 1" - by (induct xs) (auto simp add: memb_def subset_insert) + unfolding fcard_raw_def + by (induct xs) (auto) -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) - +(* used in list_eq2_equiv *) lemma memb_card_not_0: assumes a: "memb a A" shows "\(fcard_raw A = 0)" @@ -779,7 +679,11 @@ then show ?thesis using fcard_raw_0[of A] by simp qed -text {* fmap *} + + +section {* fmap *} + +(* there is another fmap section below *) lemma map_append: "map f (xs @ ys) \ (map f xs) @ (map f ys)" @@ -830,32 +734,29 @@ then show thesis using a c by blast qed + section {* deletion *} -lemma memb_delete_raw_ident: - shows "\ memb x (delete_raw xs x)" +lemma memb_removeAll_ident: + shows "\ memb 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)" +lemma fset_raw_removeAll_cases: + "xs = [] \ (\x. memb x xs \ xs \ x # removeAll x xs)" 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 finter_raw_empty: "finter_raw l [] = []" by (induct l) (simp_all add: not_memb_nil) -lemma set_cong: - shows "(x \ y) = (set x = set y)" - by auto - lemma inj_map_eq_iff: "inj f \ (map f l \ map f m) = (l \ m)" by (simp add: set_eq_iff[symmetric] inj_image_eq_iff) @@ -878,7 +779,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)") @@ -889,18 +790,18 @@ 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 not_memb_removeAll_ident) 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 removeAll_rsp: + "xs \ ys \ removeAll x xs \ removeAll x ys" + by (simp add: memb_def[symmetric]) lemma list_eq2_equiv: "(l \ r) \ (list_eq2 l r)" @@ -923,58 +824,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[OF 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)" - by (metis rev_append set_append set_cong set_rev sub_list_append sub_list_append_left sub_list_def sub_list_not_eq subset_Un_eq) - -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) - -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: 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 |\| {||}" @@ -1010,15 +880,16 @@ shows "{|x|} = {|y|} \ x = y" by (lifting singleton_list_eq) -text {* fset_to_set *} + +text {* fset *} -lemma fset_to_set_simps[simp]: - "fset_to_set {||} = ({} :: 'a set)" - "fset_to_set (finsert (h :: 'a) 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: @@ -1026,48 +897,67 @@ by (lifting none_memb_nil) lemma fset_cong: - "(S = T) = (fset_to_set S = fset_to_set T)" - by (lifting set_cong) + "(S = T) = (fset S = fset T)" + by (lifting list_eq.simps) -text {* fcard *} -lemma fcard_fempty [simp]: - shows "fcard {||} = 0" - by (lifting fcard_raw_nil) +section {* fcard *} lemma fcard_finsert_if [simp]: shows "fcard (finsert x S) = (if x |\| S then fcard S else Suc (fcard S))" - by (lifting fcard_raw_cons) + 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) + shows "fcard S = 1 \ (\x. S = {|x|})" + 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) + assumes a: "x |\| S" + shows "fcard (finsert x S) = Suc (fcard S)" + using a + by (descending) (simp add: memb_def fcard_raw_def) -lemma fcard_suc: "fcard S = Suc n \ \x T. x |\| T \ S = finsert x T \ fcard T = n" - by (lifting fcard_raw_suc) +lemma fcard_suc: + shows "fcard S = Suc n \ \x T. x |\| T \ S = finsert x T \ fcard T = n" + 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 *} + +section {* funion *} lemmas [simp] = sup_bot_left[where 'a="'a fset", standard] @@ -1078,14 +968,15 @@ by (lifting append.simps(2)) lemma singleton_union_left: - "{|a|} |\| S = finsert a S" + shows "{|a|} |\| S = finsert a S" by simp lemma singleton_union_right: - "S |\| {|a|} = finsert a S" + shows "S |\| {|a|} = finsert a S" by (subst sup.commute) simp -section {* Induction and Cases rules for finite sets *} + +section {* Induction and Cases rules for fsets *} lemma fset_strong_cases: obtains "xs = {||}" @@ -1141,7 +1032,8 @@ then show "P (finsert x zs)" using b h by simp qed -text {* fmap *} + +section {* fmap *} lemma fmap_simps[simp]: "fmap (f :: 'a \ 'b) {||} = {||}" @@ -1149,7 +1041,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: @@ -1163,76 +1055,88 @@ "x |\| S |\| T \ x |\| S \ x |\| T" by (lifting memb_append) -text {* to_set *} + +section {* fset *} -lemma fin_set: "(x |\| xs) = (x \ fset_to_set xs)" - by (lifting memb_set) +lemma fin_set: + shows "x |\| xs \ x \ fset xs" + by (lifting memb_def) -lemma fnotin_set: "(x |\| xs) = (x \ fset_to_set xs)" +lemma fnotin_set: + shows "x |\| xs \ x \ fset xs" by (simp add: fin_set) -lemma fcard_set: "fcard xs = card (fset_to_set xs)" - by (lifting fcard_raw_set) +lemma fcard_set: + shows "fcard xs = card (fset xs)" + by (lifting fcard_raw_def) -lemma fsubseteq_set: "(xs |\| ys) = (fset_to_set xs \ fset_to_set ys)" - by (lifting sub_list_set) +lemma fsubseteq_set: + shows "xs |\| ys \ fset xs \ fset ys" + by (lifting sub_list_def) -lemma fsubset_set: "(xs |\| ys) = (fset_to_set xs \ fset_to_set ys)" - unfolding less_fset by (lifting sub_list_neq_set) +lemma fsubset_set: + shows "xs |\| ys \ fset xs \ fset ys" + unfolding less_fset_def + by (descending) (auto simp add: sub_list_def) -lemma ffilter_set: "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: "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 inter_set: "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 union_set: "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: "fset_to_set (xs - ys) = fset_to_set xs - fset_to_set ys" - by (lifting fminus_raw_set) - -lemmas fset_to_set_trans = - fin_set fnotin_set fcard_set fsubseteq_set fsubset_set - inter_set union_set ffilter_set fset_to_set_simps - fset_cong fdelete_set fmap_set_image fminus_set +lemma fminus_set [simp]: + shows "fset (xs - ys) = fset xs - fset ys" + by (lifting set_fminus_raw) -text {* ffold *} + +section {* 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 *} + + +section {* 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) + shows "x |\| fdelete x S" + by (lifting memb_removeAll_ident) lemma not_memb_fdelete_ident: - shows "x |\| S \ fdelete S x = S" - by (lifting not_memb_delete_raw_ident) + shows "x |\| S \ fdelete x S = S" + by (lifting not_memb_removeAll_ident) 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 {* inter *} + +section {* finter *} lemma finter_empty_l: "({||} |\| S) = {||}" by (lifting finter_raw.simps(1)) @@ -1241,39 +1145,44 @@ by (lifting finter_raw_empty) 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: - "(finsert x xs |\| ys) = (x |\| ys \ xs |\| ys)" + shows "(finsert x xs |\| ys) = (x |\| ys \ xs |\| ys)" by (lifting sub_list_cons) -lemma "xs |\| ys \ \x. x |\| xs \ x |\| ys" - by (lifting sub_list_def[simplified memb_def[symmetric]]) +lemma + shows "xs |\| ys \ \x. x |\| xs \ x |\| ys" + by (descending) (auto simp add: sub_list_def memb_def) -lemma fsubset_fin: "xs |\| ys = (\x. x |\| xs \ x |\| ys)" -by (rule meta_eq_to_obj_eq) - (lifting sub_list_def[simplified memb_def[symmetric]]) +lemma fsubset_fin: + shows "xs |\| ys = (\x. x |\| xs \ x |\| ys)" + by (descending) (auto simp add: sub_list_def memb_def) -lemma fminus_fin: "(x |\| xs - ys) = (x |\| xs \ x |\| ys)" - by (lifting fminus_raw_memb) +lemma fminus_fin: + shows "(x |\| xs - ys) = (x |\| xs \ x |\| ys)" + by (descending) (simp add: memb_def) -lemma fminus_red: "finsert x xs - ys = (if x |\| ys then xs - ys else finsert x (xs - ys))" - by (lifting fminus_raw_red) +lemma fminus_red: + shows "finsert x xs - ys = (if x |\| ys then xs - ys else finsert x (xs - ys))" + by (descending) (auto simp add: memb_def) -lemma fminus_red_fin[simp]: "x |\| ys \ finsert x xs - ys = xs - ys" +lemma fminus_red_fin[simp]: + shows "x |\| ys \ finsert x xs - ys = xs - ys" by (simp add: fminus_red) -lemma fminus_red_fnotin[simp]: "x |\| ys \ finsert x xs - ys = finsert x (xs - ys)" +lemma fminus_red_fnotin[simp]: + shows "x |\| ys \ finsert x xs - ys = finsert x (xs - ys)" by (simp add: fminus_red) lemma fset_eq_iff: "(S = T) = (\x. (x |\| S) = (x |\| T))" - by (lifting list_eq.simps[simplified memb_def[symmetric]]) + by (descending) (auto simp add: memb_def) (* We cannot write it as "assumes .. shows" since Isabelle changes the quantifiers to schematic variables and reintroduces them in @@ -1300,7 +1209,8 @@ using assms by (lifting list_eq2.induct[simplified list_eq2_equiv[symmetric]]) -text {* concat *} + +section {* fconcat *} lemma fconcat_empty: shows "fconcat {||} = {||}" @@ -1310,110 +1220,131 @@ shows "fconcat (finsert x S) = x |\| fconcat S" by (lifting concat.simps(2)) -text {* ffilter *} + +section {* ffilter *} -lemma subseteq_filter: "ffilter P xs <= ffilter Q xs = (\ x. x |\| xs \ P x \ Q x)" -by (lifting sub_list_filter) +lemma subseteq_filter: + shows "ffilter P xs <= ffilter Q xs = (\ x. x |\| xs \ P x \ Q x)" + by (descending) (auto simp add: memb_def sub_list_def) -lemma eq_ffilter: "(ffilter P xs = ffilter Q xs) = (\x. x |\| xs \ P x = Q x)" -by (lifting list_eq_filter) - +lemma eq_ffilter: + shows "(ffilter P xs = ffilter Q xs) = (\x. x |\| xs \ P x = Q x)" + by (descending) (auto simp add: memb_def) + lemma subset_ffilter: "(\x. x |\| xs \ P x \ Q x) \ (x |\| xs & \ P x & Q x) \ ffilter P xs < ffilter Q xs" -unfolding less_fset by (auto simp add: subseteq_filter eq_ffilter) +unfolding less_fset_def by (auto simp add: subseteq_filter eq_ffilter) + section {* lemmas transferred from Finite_Set theory *} text {* finiteness for finite sets holds *} -lemma finite_fset: "finite (fset_to_set S)" +lemma finite_fset [simp]: + shows "finite (fset S)" by (induct S) auto -lemma fset_choice: "\x. x |\| A \ (\y. P x y) \ \f. \x. x |\| A \ P x (f x)" - unfolding fset_to_set_trans - by (rule finite_set_choice[simplified Ball_def, OF finite_fset]) +lemma fset_choice: + shows "\x. x |\| A \ (\y. P x y) \ \f. \x. x |\| A \ P x (f x)" + apply(descending) + apply(simp add: memb_def) + apply(rule finite_set_choice[simplified Ball_def]) + apply(simp_all) + done -lemma fsubseteq_fnil: "xs |\| {||} = (xs = {||})" - unfolding fset_to_set_trans - by (rule subset_empty) +lemma fsubseteq_fempty: + shows "xs |\| {||} = (xs = {||})" + by (metis finter_empty_r le_iff_inf) -lemma not_fsubset_fnil: "\ xs |\| {||}" - unfolding fset_to_set_trans - by (rule not_psubset_empty) - -lemma fcard_mono: "xs |\| ys \ fcard xs \ fcard ys" - unfolding fset_to_set_trans +lemma not_fsubset_fnil: + shows "\ xs |\| {||}" + by (metis fset_simps(1) fsubset_set not_psubset_empty) + +lemma fcard_mono: + shows "xs |\| ys \ fcard xs \ fcard ys" + unfolding fcard_set fsubseteq_set by (rule card_mono[OF finite_fset]) -lemma fcard_fseteq: "xs |\| ys \ fcard ys \ fcard xs \ xs = ys" - unfolding fset_to_set_trans - by (rule card_seteq[OF finite_fset]) +lemma fcard_fseteq: + shows "xs |\| ys \ fcard ys \ fcard xs \ xs = ys" + unfolding fcard_set fsubseteq_set + by (simp add: card_seteq[OF finite_fset] fset_cong) -lemma psubset_fcard_mono: "xs |\| ys \ fcard xs < fcard ys" - unfolding fset_to_set_trans +lemma psubset_fcard_mono: + shows "xs |\| ys \ fcard xs < fcard ys" + unfolding fcard_set fsubset_set by (rule psubset_card_mono[OF finite_fset]) -lemma fcard_funion_finter: "fcard xs + fcard ys = fcard (xs |\| ys) + fcard (xs |\| ys)" - unfolding fset_to_set_trans +lemma fcard_funion_finter: + shows "fcard xs + fcard ys = fcard (xs |\| ys) + fcard (xs |\| ys)" + unfolding fcard_set funion_set finter_set by (rule card_Un_Int[OF finite_fset finite_fset]) -lemma fcard_funion_disjoint: "xs |\| ys = {||} \ fcard (xs |\| ys) = fcard xs + fcard ys" - unfolding fset_to_set_trans - by (rule card_Un_disjoint[OF finite_fset finite_fset]) +lemma fcard_funion_disjoint: + shows "xs |\| ys = {||} \ fcard (xs |\| ys) = fcard xs + fcard ys" + unfolding fcard_set funion_set + apply (rule card_Un_disjoint[OF finite_fset finite_fset]) + by (metis finter_set fset_simps(1)) -lemma fcard_delete1_less: "x |\| xs \ fcard (fdelete xs x) < fcard xs" - unfolding fset_to_set_trans +lemma fcard_delete1_less: + shows "x |\| xs \ fcard (fdelete x xs) < fcard xs" + unfolding fcard_set fin_set fdelete_set by (rule card_Diff1_less[OF finite_fset]) -lemma fcard_delete2_less: "x |\| xs \ y |\| xs \ fcard (fdelete (fdelete xs x) y) < fcard xs" - unfolding fset_to_set_trans +lemma fcard_delete2_less: + shows "x |\| xs \ y |\| xs \ fcard (fdelete y (fdelete x xs)) < fcard xs" + unfolding fcard_set fdelete_set fin_set by (rule card_Diff2_less[OF finite_fset]) -lemma fcard_delete1_le: "fcard (fdelete xs x) <= fcard xs" - unfolding fset_to_set_trans +lemma fcard_delete1_le: + shows "fcard (fdelete x xs) <= fcard xs" + unfolding fdelete_set fcard_set by (rule card_Diff1_le[OF finite_fset]) -lemma fcard_psubset: "ys |\| xs \ fcard ys < fcard xs \ ys |\| xs" - unfolding fset_to_set_trans +lemma fcard_psubset: + shows "ys |\| xs \ fcard ys < fcard xs \ ys |\| xs" + unfolding fcard_set fsubseteq_set fsubset_set by (rule card_psubset[OF finite_fset]) -lemma fcard_fmap_le: "fcard (fmap f xs) \ fcard xs" - unfolding fset_to_set_trans +lemma fcard_fmap_le: + shows "fcard (fmap f xs) \ fcard xs" + unfolding fcard_set fmap_set_image by (rule card_image_le[OF finite_fset]) -lemma fin_fminus_fnotin: "x |\| F - S \ x |\| S" - unfolding fset_to_set_trans +lemma fin_fminus_fnotin: + shows "x |\| F - S \ x |\| S" + unfolding fin_set fminus_set by blast -lemma fin_fnotin_fminus: "x |\| S \ x |\| F - S" - unfolding fset_to_set_trans +lemma fin_fnotin_fminus: + shows "x |\| S \ x |\| F - S" + unfolding fin_set fminus_set by blast -lemma fin_mdef: "x |\| F = ((x |\| (F - {|x|})) & (F = finsert x (F - {|x|})))" - unfolding fset_to_set_trans +lemma fin_mdef: + shows "x |\| F = ((x |\| (F - {|x|})) & (F = finsert x (F - {|x|})))" + unfolding fin_set fset_simps fset_cong fminus_set 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 - by (rule card_Diff_insert[OF finite_fset]) + shows "fcard (A - finsert a B) = fcard (A - B) - 1" + using assms + unfolding fin_set fcard_set fminus_set + by (simp add: card_Diff_insert[OF finite_fset]) lemma fcard_fminus_fsubset: assumes "B |\| A" shows "fcard (A - B) = fcard A - fcard B" - using assms unfolding fset_to_set_trans + using assms + unfolding fsubseteq_set fcard_set fminus_set by (rule card_Diff_subset[OF finite_fset]) lemma fcard_fminus_subset_finter: - "fcard (A - B) = fcard A - fcard (A |\| B)" - unfolding fset_to_set_trans - by (rule card_Diff_subset_Int) (fold inter_set, rule finite_fset) + shows "fcard (A - B) = fcard A - fcard (A |\| B)" + using assms + unfolding finter_set fcard_set fminus_set + by (rule card_Diff_subset_Int) (simp) -lemma ball_reg_right_unfolded: "(\x. R x \ P x \ Q x) \ (All P \ Ball R Q)" -apply rule -apply (rule ball_reg_right) -apply auto -done lemma list_all2_refl: assumes q: "equivp R"