# HG changeset patch # User haftmann # Date 1290444411 -3600 # Node ID abd4e73588476ee507d97dee5b21c97bf3e12e40 # Parent 5e46057ba8e099fc9a768a9de48fc5ef01dc5fac replaced misleading Fset/fset name -- these do not stand for finite sets diff -r 5e46057ba8e0 -r abd4e7358847 NEWS --- a/NEWS Mon Nov 22 09:37:39 2010 +0100 +++ b/NEWS Mon Nov 22 17:46:51 2010 +0100 @@ -89,6 +89,9 @@ *** HOL *** +* Renamed theory Fset to Cset, type Fset.fset to Cset.set, in order to +avoid confusion with finite sets. INCOMPATIBILITY. + * Theory Multiset provides stable quicksort implementation of sort_key. * Quickcheck now has a configurable time limit which is set to 30 seconds diff -r 5e46057ba8e0 -r abd4e7358847 src/HOL/IsaMakefile --- a/src/HOL/IsaMakefile Mon Nov 22 09:37:39 2010 +0100 +++ b/src/HOL/IsaMakefile Mon Nov 22 17:46:51 2010 +0100 @@ -419,7 +419,7 @@ Library/Efficient_Nat.thy Library/Enum.thy Library/Eval_Witness.thy \ Library/Executable_Set.thy Library/Float.thy \ Library/Formal_Power_Series.thy Library/Fraction_Field.thy \ - Library/FrechetDeriv.thy Library/Fset.thy Library/FuncSet.thy \ + Library/FrechetDeriv.thy Library/Cset.thy Library/FuncSet.thy \ Library/Function_Algebras.thy \ Library/Fundamental_Theorem_Algebra.thy Library/Glbs.thy \ Library/Indicator_Function.thy Library/Infinite_Set.thy \ diff -r 5e46057ba8e0 -r abd4e7358847 src/HOL/Library/Cset.thy --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/HOL/Library/Cset.thy Mon Nov 22 17:46:51 2010 +0100 @@ -0,0 +1,357 @@ + +(* Author: Florian Haftmann, TU Muenchen *) + +header {* A dedicated set type which is executable on its finite part *} + +theory Cset +imports More_Set More_List +begin + +subsection {* Lifting *} + +typedef (open) 'a set = "UNIV :: 'a set set" + morphisms member Set by rule+ +hide_type (open) set + +lemma member_Set [simp]: + "member (Set A) = A" + by (rule Set_inverse) rule + +lemma Set_member [simp]: + "Set (member A) = A" + by (fact member_inverse) + +lemma Set_inject [simp]: + "Set A = Set B \ A = B" + by (simp add: Set_inject) + +lemma set_eq_iff: + "A = B \ member A = member B" + by (simp add: member_inject) +hide_fact (open) set_eq_iff + +lemma set_eqI: + "member A = member B \ A = B" + by (simp add: Cset.set_eq_iff) +hide_fact (open) set_eqI + +declare mem_def [simp] + +definition set :: "'a list \ 'a Cset.set" where + "set xs = Set (List.set xs)" +hide_const (open) set + +lemma member_set [simp]: + "member (Cset.set xs) = set xs" + by (simp add: set_def) +hide_fact (open) member_set + +definition coset :: "'a list \ 'a Cset.set" where + "coset xs = Set (- set xs)" +hide_const (open) coset + +lemma member_coset [simp]: + "member (Cset.coset xs) = - set xs" + by (simp add: coset_def) +hide_fact (open) member_coset + +code_datatype Cset.set Cset.coset + +lemma member_code [code]: + "member (Cset.set xs) = List.member xs" + "member (Cset.coset xs) = Not \ List.member xs" + by (simp_all add: fun_eq_iff member_def fun_Compl_def bool_Compl_def) + +lemma member_image_UNIV [simp]: + "member ` UNIV = UNIV" +proof - + have "\A \ 'a set. \B \ 'a Cset.set. A = member B" + proof + fix A :: "'a set" + show "A = member (Set A)" by simp + qed + then show ?thesis by (simp add: image_def) +qed + +definition (in term_syntax) + setify :: "'a\typerep list \ (unit \ Code_Evaluation.term) + \ 'a Cset.set \ (unit \ Code_Evaluation.term)" where + [code_unfold]: "setify xs = Code_Evaluation.valtermify Cset.set {\} xs" + +notation fcomp (infixl "\>" 60) +notation scomp (infixl "\\" 60) + +instantiation Cset.set :: (random) random +begin + +definition + "Quickcheck.random i = Quickcheck.random i \\ (\xs. Pair (setify xs))" + +instance .. + +end + +no_notation fcomp (infixl "\>" 60) +no_notation scomp (infixl "\\" 60) + + +subsection {* Lattice instantiation *} + +instantiation Cset.set :: (type) boolean_algebra +begin + +definition less_eq_set :: "'a Cset.set \ 'a Cset.set \ bool" where + [simp]: "A \ B \ member A \ member B" + +definition less_set :: "'a Cset.set \ 'a Cset.set \ bool" where + [simp]: "A < B \ member A \ member B" + +definition inf_set :: "'a Cset.set \ 'a Cset.set \ 'a Cset.set" where + [simp]: "inf A B = Set (member A \ member B)" + +definition sup_set :: "'a Cset.set \ 'a Cset.set \ 'a Cset.set" where + [simp]: "sup A B = Set (member A \ member B)" + +definition bot_set :: "'a Cset.set" where + [simp]: "bot = Set {}" + +definition top_set :: "'a Cset.set" where + [simp]: "top = Set UNIV" + +definition uminus_set :: "'a Cset.set \ 'a Cset.set" where + [simp]: "- A = Set (- (member A))" + +definition minus_set :: "'a Cset.set \ 'a Cset.set \ 'a Cset.set" where + [simp]: "A - B = Set (member A - member B)" + +instance proof +qed (auto intro: Cset.set_eqI) + +end + +instantiation Cset.set :: (type) complete_lattice +begin + +definition Inf_set :: "'a Cset.set set \ 'a Cset.set" where + [simp]: "Inf_set As = Set (Inf (image member As))" + +definition Sup_set :: "'a Cset.set set \ 'a Cset.set" where + [simp]: "Sup_set As = Set (Sup (image member As))" + +instance proof +qed (auto simp add: le_fun_def le_bool_def) + +end + + +subsection {* Basic operations *} + +definition is_empty :: "'a Cset.set \ bool" where + [simp]: "is_empty A \ More_Set.is_empty (member A)" + +lemma is_empty_set [code]: + "is_empty (Cset.set xs) \ List.null xs" + by (simp add: is_empty_set) +hide_fact (open) is_empty_set + +lemma empty_set [code]: + "bot = Cset.set []" + by (simp add: set_def) +hide_fact (open) empty_set + +lemma UNIV_set [code]: + "top = Cset.coset []" + by (simp add: coset_def) +hide_fact (open) UNIV_set + +definition insert :: "'a \ 'a Cset.set \ 'a Cset.set" where + [simp]: "insert x A = Set (Set.insert x (member A))" + +lemma insert_set [code]: + "insert x (Cset.set xs) = Cset.set (List.insert x xs)" + "insert x (Cset.coset xs) = Cset.coset (removeAll x xs)" + by (simp_all add: set_def coset_def) + +definition remove :: "'a \ 'a Cset.set \ 'a Cset.set" where + [simp]: "remove x A = Set (More_Set.remove x (member A))" + +lemma remove_set [code]: + "remove x (Cset.set xs) = Cset.set (removeAll x xs)" + "remove x (Cset.coset xs) = Cset.coset (List.insert x xs)" + by (simp_all add: set_def coset_def remove_set_compl) + (simp add: More_Set.remove_def) + +definition map :: "('a \ 'b) \ 'a Cset.set \ 'b Cset.set" where + [simp]: "map f A = Set (image f (member A))" + +lemma map_set [code]: + "map f (Cset.set xs) = Cset.set (remdups (List.map f xs))" + by (simp add: set_def) + +type_mapper map + by (simp_all add: image_image) + +definition filter :: "('a \ bool) \ 'a Cset.set \ 'a Cset.set" where + [simp]: "filter P A = Set (More_Set.project P (member A))" + +lemma filter_set [code]: + "filter P (Cset.set xs) = Cset.set (List.filter P xs)" + by (simp add: set_def project_set) + +definition forall :: "('a \ bool) \ 'a Cset.set \ bool" where + [simp]: "forall P A \ Ball (member A) P" + +lemma forall_set [code]: + "forall P (Cset.set xs) \ list_all P xs" + by (simp add: set_def list_all_iff) + +definition exists :: "('a \ bool) \ 'a Cset.set \ bool" where + [simp]: "exists P A \ Bex (member A) P" + +lemma exists_set [code]: + "exists P (Cset.set xs) \ list_ex P xs" + by (simp add: set_def list_ex_iff) + +definition card :: "'a Cset.set \ nat" where + [simp]: "card A = Finite_Set.card (member A)" + +lemma card_set [code]: + "card (Cset.set xs) = length (remdups xs)" +proof - + have "Finite_Set.card (set (remdups xs)) = length (remdups xs)" + by (rule distinct_card) simp + then show ?thesis by (simp add: set_def) +qed + +lemma compl_set [simp, code]: + "- Cset.set xs = Cset.coset xs" + by (simp add: set_def coset_def) + +lemma compl_coset [simp, code]: + "- Cset.coset xs = Cset.set xs" + by (simp add: set_def coset_def) + + +subsection {* Derived operations *} + +lemma subset_eq_forall [code]: + "A \ B \ forall (member B) A" + by (simp add: subset_eq) + +lemma subset_subset_eq [code]: + "A < B \ A \ B \ \ B \ (A :: 'a Cset.set)" + by (fact less_le_not_le) + +instantiation Cset.set :: (type) equal +begin + +definition [code]: + "HOL.equal A B \ A \ B \ B \ (A :: 'a Cset.set)" + +instance proof +qed (simp add: equal_set_def set_eq [symmetric] Cset.set_eq_iff) + +end + +lemma [code nbe]: + "HOL.equal (A :: 'a Cset.set) A \ True" + by (fact equal_refl) + + +subsection {* Functorial operations *} + +lemma inter_project [code]: + "inf A (Cset.set xs) = Cset.set (List.filter (member A) xs)" + "inf A (Cset.coset xs) = foldr remove xs A" +proof - + show "inf A (Cset.set xs) = Cset.set (List.filter (member A) xs)" + by (simp add: inter project_def set_def) + have *: "\x::'a. remove = (\x. Set \ More_Set.remove x \ member)" + by (simp add: fun_eq_iff) + have "member \ fold (\x. Set \ More_Set.remove x \ member) xs = + fold More_Set.remove xs \ member" + by (rule fold_commute) (simp add: fun_eq_iff) + then have "fold More_Set.remove xs (member A) = + member (fold (\x. Set \ More_Set.remove x \ member) xs A)" + by (simp add: fun_eq_iff) + then have "inf A (Cset.coset xs) = fold remove xs A" + by (simp add: Diff_eq [symmetric] minus_set *) + moreover have "\x y :: 'a. Cset.remove y \ Cset.remove x = Cset.remove x \ Cset.remove y" + by (auto simp add: More_Set.remove_def * intro: ext) + ultimately show "inf A (Cset.coset xs) = foldr remove xs A" + by (simp add: foldr_fold) +qed + +lemma subtract_remove [code]: + "A - Cset.set xs = foldr remove xs A" + "A - Cset.coset xs = Cset.set (List.filter (member A) xs)" + by (simp_all only: diff_eq compl_set compl_coset inter_project) + +lemma union_insert [code]: + "sup (Cset.set xs) A = foldr insert xs A" + "sup (Cset.coset xs) A = Cset.coset (List.filter (Not \ member A) xs)" +proof - + have *: "\x::'a. insert = (\x. Set \ Set.insert x \ member)" + by (simp add: fun_eq_iff) + have "member \ fold (\x. Set \ Set.insert x \ member) xs = + fold Set.insert xs \ member" + by (rule fold_commute) (simp add: fun_eq_iff) + then have "fold Set.insert xs (member A) = + member (fold (\x. Set \ Set.insert x \ member) xs A)" + by (simp add: fun_eq_iff) + then have "sup (Cset.set xs) A = fold insert xs A" + by (simp add: union_set *) + moreover have "\x y :: 'a. Cset.insert y \ Cset.insert x = Cset.insert x \ Cset.insert y" + by (auto simp add: * intro: ext) + ultimately show "sup (Cset.set xs) A = foldr insert xs A" + by (simp add: foldr_fold) + show "sup (Cset.coset xs) A = Cset.coset (List.filter (Not \ member A) xs)" + by (auto simp add: coset_def) +qed + +context complete_lattice +begin + +definition Infimum :: "'a Cset.set \ 'a" where + [simp]: "Infimum A = Inf (member A)" + +lemma Infimum_inf [code]: + "Infimum (Cset.set As) = foldr inf As top" + "Infimum (Cset.coset []) = bot" + by (simp_all add: Inf_set_foldr Inf_UNIV) + +definition Supremum :: "'a Cset.set \ 'a" where + [simp]: "Supremum A = Sup (member A)" + +lemma Supremum_sup [code]: + "Supremum (Cset.set As) = foldr sup As bot" + "Supremum (Cset.coset []) = top" + by (simp_all add: Sup_set_foldr Sup_UNIV) + +end + + +subsection {* Simplified simprules *} + +lemma is_empty_simp [simp]: + "is_empty A \ member A = {}" + by (simp add: More_Set.is_empty_def) +declare is_empty_def [simp del] + +lemma remove_simp [simp]: + "remove x A = Set (member A - {x})" + by (simp add: More_Set.remove_def) +declare remove_def [simp del] + +lemma filter_simp [simp]: + "filter P A = Set {x \ member A. P x}" + by (simp add: More_Set.project_def) +declare filter_def [simp del] + +declare mem_def [simp del] + + +hide_const (open) setify is_empty insert remove map filter forall exists card + Inter Union + +end diff -r 5e46057ba8e0 -r abd4e7358847 src/HOL/Library/Dlist.thy --- a/src/HOL/Library/Dlist.thy Mon Nov 22 09:37:39 2010 +0100 +++ b/src/HOL/Library/Dlist.thy Mon Nov 22 17:46:51 2010 +0100 @@ -3,7 +3,7 @@ header {* Lists with elements distinct as canonical example for datatype invariants *} theory Dlist -imports Main Fset +imports Main Cset begin section {* The type of distinct lists *} @@ -181,27 +181,27 @@ section {* Implementation of sets by distinct lists -- canonical! *} -definition Set :: "'a dlist \ 'a fset" where - "Set dxs = Fset.Set (list_of_dlist dxs)" +definition Set :: "'a dlist \ 'a Cset.set" where + "Set dxs = Cset.set (list_of_dlist dxs)" -definition Coset :: "'a dlist \ 'a fset" where - "Coset dxs = Fset.Coset (list_of_dlist dxs)" +definition Coset :: "'a dlist \ 'a Cset.set" where + "Coset dxs = Cset.coset (list_of_dlist dxs)" code_datatype Set Coset declare member_code [code del] -declare is_empty_Set [code del] -declare empty_Set [code del] -declare UNIV_Set [code del] -declare insert_Set [code del] -declare remove_Set [code del] -declare compl_Set [code del] -declare compl_Coset [code del] -declare map_Set [code del] -declare filter_Set [code del] -declare forall_Set [code del] -declare exists_Set [code del] -declare card_Set [code del] +declare Cset.is_empty_set [code del] +declare Cset.empty_set [code del] +declare Cset.UNIV_set [code del] +declare insert_set [code del] +declare remove_set [code del] +declare compl_set [code del] +declare compl_coset [code del] +declare map_set [code del] +declare filter_set [code del] +declare forall_set [code del] +declare exists_set [code del] +declare card_set [code del] declare inter_project [code del] declare subtract_remove [code del] declare union_insert [code del] @@ -209,31 +209,31 @@ declare Supremum_sup [code del] lemma Set_Dlist [simp]: - "Set (Dlist xs) = Fset (set xs)" - by (rule fset_eqI) (simp add: Set_def) + "Set (Dlist xs) = Cset.Set (set xs)" + by (rule Cset.set_eqI) (simp add: Set_def) lemma Coset_Dlist [simp]: - "Coset (Dlist xs) = Fset (- set xs)" - by (rule fset_eqI) (simp add: Coset_def) + "Coset (Dlist xs) = Cset.Set (- set xs)" + by (rule Cset.set_eqI) (simp add: Coset_def) lemma member_Set [simp]: - "Fset.member (Set dxs) = List.member (list_of_dlist dxs)" + "Cset.member (Set dxs) = List.member (list_of_dlist dxs)" by (simp add: Set_def member_set) lemma member_Coset [simp]: - "Fset.member (Coset dxs) = Not \ List.member (list_of_dlist dxs)" + "Cset.member (Coset dxs) = Not \ List.member (list_of_dlist dxs)" by (simp add: Coset_def member_set not_set_compl) lemma Set_dlist_of_list [code]: - "Fset.Set xs = Set (dlist_of_list xs)" - by (rule fset_eqI) simp + "Cset.set xs = Set (dlist_of_list xs)" + by (rule Cset.set_eqI) simp lemma Coset_dlist_of_list [code]: - "Fset.Coset xs = Coset (dlist_of_list xs)" - by (rule fset_eqI) simp + "Cset.coset xs = Coset (dlist_of_list xs)" + by (rule Cset.set_eqI) simp lemma is_empty_Set [code]: - "Fset.is_empty (Set dxs) \ null dxs" + "Cset.is_empty (Set dxs) \ null dxs" by (simp add: null_def List.null_def member_set) lemma bot_code [code]: @@ -245,58 +245,58 @@ by (simp add: empty_def) lemma insert_code [code]: - "Fset.insert x (Set dxs) = Set (insert x dxs)" - "Fset.insert x (Coset dxs) = Coset (remove x dxs)" + "Cset.insert x (Set dxs) = Set (insert x dxs)" + "Cset.insert x (Coset dxs) = Coset (remove x dxs)" by (simp_all add: insert_def remove_def member_set not_set_compl) lemma remove_code [code]: - "Fset.remove x (Set dxs) = Set (remove x dxs)" - "Fset.remove x (Coset dxs) = Coset (insert x dxs)" + "Cset.remove x (Set dxs) = Set (remove x dxs)" + "Cset.remove x (Coset dxs) = Coset (insert x dxs)" by (auto simp add: insert_def remove_def member_set not_set_compl) lemma member_code [code]: - "Fset.member (Set dxs) = member dxs" - "Fset.member (Coset dxs) = Not \ member dxs" + "Cset.member (Set dxs) = member dxs" + "Cset.member (Coset dxs) = Not \ member dxs" by (simp_all add: member_def) lemma compl_code [code]: "- Set dxs = Coset dxs" "- Coset dxs = Set dxs" - by (rule fset_eqI, simp add: member_set not_set_compl)+ + by (rule Cset.set_eqI, simp add: member_set not_set_compl)+ lemma map_code [code]: - "Fset.map f (Set dxs) = Set (map f dxs)" - by (rule fset_eqI) (simp add: member_set) + "Cset.map f (Set dxs) = Set (map f dxs)" + by (rule Cset.set_eqI) (simp add: member_set) lemma filter_code [code]: - "Fset.filter f (Set dxs) = Set (filter f dxs)" - by (rule fset_eqI) (simp add: member_set) + "Cset.filter f (Set dxs) = Set (filter f dxs)" + by (rule Cset.set_eqI) (simp add: member_set) lemma forall_Set [code]: - "Fset.forall P (Set xs) \ list_all P (list_of_dlist xs)" + "Cset.forall P (Set xs) \ list_all P (list_of_dlist xs)" by (simp add: member_set list_all_iff) lemma exists_Set [code]: - "Fset.exists P (Set xs) \ list_ex P (list_of_dlist xs)" + "Cset.exists P (Set xs) \ list_ex P (list_of_dlist xs)" by (simp add: member_set list_ex_iff) lemma card_code [code]: - "Fset.card (Set dxs) = length dxs" + "Cset.card (Set dxs) = length dxs" by (simp add: length_def member_set distinct_card) lemma inter_code [code]: - "inf A (Set xs) = Set (filter (Fset.member A) xs)" - "inf A (Coset xs) = foldr Fset.remove xs A" + "inf A (Set xs) = Set (filter (Cset.member A) xs)" + "inf A (Coset xs) = foldr Cset.remove xs A" by (simp_all only: Set_def Coset_def foldr_def inter_project list_of_dlist_filter) lemma subtract_code [code]: - "A - Set xs = foldr Fset.remove xs A" - "A - Coset xs = Set (filter (Fset.member A) xs)" + "A - Set xs = foldr Cset.remove xs A" + "A - Coset xs = Set (filter (Cset.member A) xs)" by (simp_all only: Set_def Coset_def foldr_def subtract_remove list_of_dlist_filter) lemma union_code [code]: - "sup (Set xs) A = foldr Fset.insert xs A" - "sup (Coset xs) A = Coset (filter (Not \ Fset.member A) xs)" + "sup (Set xs) A = foldr Cset.insert xs A" + "sup (Coset xs) A = Coset (filter (Not \ Cset.member A) xs)" by (simp_all only: Set_def Coset_def foldr_def union_insert list_of_dlist_filter) context complete_lattice diff -r 5e46057ba8e0 -r abd4e7358847 src/HOL/Library/Executable_Set.thy --- a/src/HOL/Library/Executable_Set.thy Mon Nov 22 09:37:39 2010 +0100 +++ b/src/HOL/Library/Executable_Set.thy Mon Nov 22 17:46:51 2010 +0100 @@ -12,7 +12,7 @@ text {* This is just an ad-hoc hack which will rarely give you what you want. For the moment, whenever you need executable sets, consider using - type @{text fset} from theory @{text Fset}. + type @{text fset} from theory @{text Cset}. *} declare mem_def [code del] diff -r 5e46057ba8e0 -r abd4e7358847 src/HOL/Library/Fset.thy --- a/src/HOL/Library/Fset.thy Mon Nov 22 09:37:39 2010 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,347 +0,0 @@ - -(* Author: Florian Haftmann, TU Muenchen *) - -header {* A set type which is executable on its finite part *} - -theory Fset -imports More_Set More_List -begin - -subsection {* Lifting *} - -typedef (open) 'a fset = "UNIV :: 'a set set" - morphisms member Fset by rule+ - -lemma member_Fset [simp]: - "member (Fset A) = A" - by (rule Fset_inverse) rule - -lemma Fset_member [simp]: - "Fset (member A) = A" - by (fact member_inverse) - -lemma Fset_inject [simp]: - "Fset A = Fset B \ A = B" - by (simp add: Fset_inject) - -lemma fset_eq_iff: - "A = B \ member A = member B" - by (simp add: member_inject) - -lemma fset_eqI: - "member A = member B \ A = B" - by (simp add: fset_eq_iff) - -declare mem_def [simp] - -definition Set :: "'a list \ 'a fset" where - "Set xs = Fset (set xs)" - -lemma member_Set [simp]: - "member (Set xs) = set xs" - by (simp add: Set_def) - -definition Coset :: "'a list \ 'a fset" where - "Coset xs = Fset (- set xs)" - -lemma member_Coset [simp]: - "member (Coset xs) = - set xs" - by (simp add: Coset_def) - -code_datatype Set Coset - -lemma member_code [code]: - "member (Set xs) = List.member xs" - "member (Coset xs) = Not \ List.member xs" - by (simp_all add: fun_eq_iff member_def fun_Compl_def bool_Compl_def) - -lemma member_image_UNIV [simp]: - "member ` UNIV = UNIV" -proof - - have "\A \ 'a set. \B \ 'a fset. A = member B" - proof - fix A :: "'a set" - show "A = member (Fset A)" by simp - qed - then show ?thesis by (simp add: image_def) -qed - -definition (in term_syntax) - setify :: "'a\typerep list \ (unit \ Code_Evaluation.term) - \ 'a fset \ (unit \ Code_Evaluation.term)" where - [code_unfold]: "setify xs = Code_Evaluation.valtermify Set {\} xs" - -notation fcomp (infixl "\>" 60) -notation scomp (infixl "\\" 60) - -instantiation fset :: (random) random -begin - -definition - "Quickcheck.random i = Quickcheck.random i \\ (\xs. Pair (setify xs))" - -instance .. - -end - -no_notation fcomp (infixl "\>" 60) -no_notation scomp (infixl "\\" 60) - - -subsection {* Lattice instantiation *} - -instantiation fset :: (type) boolean_algebra -begin - -definition less_eq_fset :: "'a fset \ 'a fset \ bool" where - [simp]: "A \ B \ member A \ member B" - -definition less_fset :: "'a fset \ 'a fset \ bool" where - [simp]: "A < B \ member A \ member B" - -definition inf_fset :: "'a fset \ 'a fset \ 'a fset" where - [simp]: "inf A B = Fset (member A \ member B)" - -definition sup_fset :: "'a fset \ 'a fset \ 'a fset" where - [simp]: "sup A B = Fset (member A \ member B)" - -definition bot_fset :: "'a fset" where - [simp]: "bot = Fset {}" - -definition top_fset :: "'a fset" where - [simp]: "top = Fset UNIV" - -definition uminus_fset :: "'a fset \ 'a fset" where - [simp]: "- A = Fset (- (member A))" - -definition minus_fset :: "'a fset \ 'a fset \ 'a fset" where - [simp]: "A - B = Fset (member A - member B)" - -instance proof -qed (auto intro: fset_eqI) - -end - -instantiation fset :: (type) complete_lattice -begin - -definition Inf_fset :: "'a fset set \ 'a fset" where - [simp]: "Inf_fset As = Fset (Inf (image member As))" - -definition Sup_fset :: "'a fset set \ 'a fset" where - [simp]: "Sup_fset As = Fset (Sup (image member As))" - -instance proof -qed (auto simp add: le_fun_def le_bool_def) - -end - - -subsection {* Basic operations *} - -definition is_empty :: "'a fset \ bool" where - [simp]: "is_empty A \ More_Set.is_empty (member A)" - -lemma is_empty_Set [code]: - "is_empty (Set xs) \ List.null xs" - by (simp add: is_empty_set) - -lemma empty_Set [code]: - "bot = Set []" - by (simp add: Set_def) - -lemma UNIV_Set [code]: - "top = Coset []" - by (simp add: Coset_def) - -definition insert :: "'a \ 'a fset \ 'a fset" where - [simp]: "insert x A = Fset (Set.insert x (member A))" - -lemma insert_Set [code]: - "insert x (Set xs) = Set (List.insert x xs)" - "insert x (Coset xs) = Coset (removeAll x xs)" - by (simp_all add: Set_def Coset_def) - -definition remove :: "'a \ 'a fset \ 'a fset" where - [simp]: "remove x A = Fset (More_Set.remove x (member A))" - -lemma remove_Set [code]: - "remove x (Set xs) = Set (removeAll x xs)" - "remove x (Coset xs) = Coset (List.insert x xs)" - by (simp_all add: Set_def Coset_def remove_set_compl) - (simp add: More_Set.remove_def) - -definition map :: "('a \ 'b) \ 'a fset \ 'b fset" where - [simp]: "map f A = Fset (image f (member A))" - -lemma map_Set [code]: - "map f (Set xs) = Set (remdups (List.map f xs))" - by (simp add: Set_def) - -type_mapper map - by (simp_all add: image_image) - -definition filter :: "('a \ bool) \ 'a fset \ 'a fset" where - [simp]: "filter P A = Fset (More_Set.project P (member A))" - -lemma filter_Set [code]: - "filter P (Set xs) = Set (List.filter P xs)" - by (simp add: Set_def project_set) - -definition forall :: "('a \ bool) \ 'a fset \ bool" where - [simp]: "forall P A \ Ball (member A) P" - -lemma forall_Set [code]: - "forall P (Set xs) \ list_all P xs" - by (simp add: Set_def list_all_iff) - -definition exists :: "('a \ bool) \ 'a fset \ bool" where - [simp]: "exists P A \ Bex (member A) P" - -lemma exists_Set [code]: - "exists P (Set xs) \ list_ex P xs" - by (simp add: Set_def list_ex_iff) - -definition card :: "'a fset \ nat" where - [simp]: "card A = Finite_Set.card (member A)" - -lemma card_Set [code]: - "card (Set xs) = length (remdups xs)" -proof - - have "Finite_Set.card (set (remdups xs)) = length (remdups xs)" - by (rule distinct_card) simp - then show ?thesis by (simp add: Set_def) -qed - -lemma compl_Set [simp, code]: - "- Set xs = Coset xs" - by (simp add: Set_def Coset_def) - -lemma compl_Coset [simp, code]: - "- Coset xs = Set xs" - by (simp add: Set_def Coset_def) - - -subsection {* Derived operations *} - -lemma subfset_eq_forall [code]: - "A \ B \ forall (member B) A" - by (simp add: subset_eq) - -lemma subfset_subfset_eq [code]: - "A < B \ A \ B \ \ B \ (A :: 'a fset)" - by (fact less_le_not_le) - -instantiation fset :: (type) equal -begin - -definition [code]: - "HOL.equal A B \ A \ B \ B \ (A :: 'a fset)" - -instance proof -qed (simp add: equal_fset_def set_eq [symmetric] fset_eq_iff) - -end - -lemma [code nbe]: - "HOL.equal (A :: 'a fset) A \ True" - by (fact equal_refl) - - -subsection {* Functorial operations *} - -lemma inter_project [code]: - "inf A (Set xs) = Set (List.filter (member A) xs)" - "inf A (Coset xs) = foldr remove xs A" -proof - - show "inf A (Set xs) = Set (List.filter (member A) xs)" - by (simp add: inter project_def Set_def) - have *: "\x::'a. remove = (\x. Fset \ More_Set.remove x \ member)" - by (simp add: fun_eq_iff) - have "member \ fold (\x. Fset \ More_Set.remove x \ member) xs = - fold More_Set.remove xs \ member" - by (rule fold_commute) (simp add: fun_eq_iff) - then have "fold More_Set.remove xs (member A) = - member (fold (\x. Fset \ More_Set.remove x \ member) xs A)" - by (simp add: fun_eq_iff) - then have "inf A (Coset xs) = fold remove xs A" - by (simp add: Diff_eq [symmetric] minus_set *) - moreover have "\x y :: 'a. Fset.remove y \ Fset.remove x = Fset.remove x \ Fset.remove y" - by (auto simp add: More_Set.remove_def * intro: ext) - ultimately show "inf A (Coset xs) = foldr remove xs A" - by (simp add: foldr_fold) -qed - -lemma subtract_remove [code]: - "A - Set xs = foldr remove xs A" - "A - Coset xs = Set (List.filter (member A) xs)" - by (simp_all only: diff_eq compl_Set compl_Coset inter_project) - -lemma union_insert [code]: - "sup (Set xs) A = foldr insert xs A" - "sup (Coset xs) A = Coset (List.filter (Not \ member A) xs)" -proof - - have *: "\x::'a. insert = (\x. Fset \ Set.insert x \ member)" - by (simp add: fun_eq_iff) - have "member \ fold (\x. Fset \ Set.insert x \ member) xs = - fold Set.insert xs \ member" - by (rule fold_commute) (simp add: fun_eq_iff) - then have "fold Set.insert xs (member A) = - member (fold (\x. Fset \ Set.insert x \ member) xs A)" - by (simp add: fun_eq_iff) - then have "sup (Set xs) A = fold insert xs A" - by (simp add: union_set *) - moreover have "\x y :: 'a. Fset.insert y \ Fset.insert x = Fset.insert x \ Fset.insert y" - by (auto simp add: * intro: ext) - ultimately show "sup (Set xs) A = foldr insert xs A" - by (simp add: foldr_fold) - show "sup (Coset xs) A = Coset (List.filter (Not \ member A) xs)" - by (auto simp add: Coset_def) -qed - -context complete_lattice -begin - -definition Infimum :: "'a fset \ 'a" where - [simp]: "Infimum A = Inf (member A)" - -lemma Infimum_inf [code]: - "Infimum (Set As) = foldr inf As top" - "Infimum (Coset []) = bot" - by (simp_all add: Inf_set_foldr Inf_UNIV) - -definition Supremum :: "'a fset \ 'a" where - [simp]: "Supremum A = Sup (member A)" - -lemma Supremum_sup [code]: - "Supremum (Set As) = foldr sup As bot" - "Supremum (Coset []) = top" - by (simp_all add: Sup_set_foldr Sup_UNIV) - -end - - -subsection {* Simplified simprules *} - -lemma is_empty_simp [simp]: - "is_empty A \ member A = {}" - by (simp add: More_Set.is_empty_def) -declare is_empty_def [simp del] - -lemma remove_simp [simp]: - "remove x A = Fset (member A - {x})" - by (simp add: More_Set.remove_def) -declare remove_def [simp del] - -lemma filter_simp [simp]: - "filter P A = Fset {x \ member A. P x}" - by (simp add: More_Set.project_def) -declare filter_def [simp del] - -declare mem_def [simp del] - - -hide_const (open) setify is_empty insert remove map filter forall exists card - Inter Union - -end diff -r 5e46057ba8e0 -r abd4e7358847 src/HOL/Library/Library.thy --- a/src/HOL/Library/Library.thy Mon Nov 22 09:37:39 2010 +0100 +++ b/src/HOL/Library/Library.thy Mon Nov 22 17:46:51 2010 +0100 @@ -20,7 +20,7 @@ Formal_Power_Series Fraction_Field FrechetDeriv - Fset + Cset FuncSet Function_Algebras Fundamental_Theorem_Algebra diff -r 5e46057ba8e0 -r abd4e7358847 src/HOL/Quotient_Examples/FSet.thy --- a/src/HOL/Quotient_Examples/FSet.thy Mon Nov 22 09:37:39 2010 +0100 +++ b/src/HOL/Quotient_Examples/FSet.thy Mon Nov 22 17:46:51 2010 +0100 @@ -25,7 +25,7 @@ unfolding reflp_def symp_def transp_def by auto -text {* Fset type *} +text {* Cset type *} quotient_type 'a fset = "'a list" / "list_eq"