diff -r c059d550afec -r 23904fa13e03 src/HOL/Library/Fset.thy --- a/src/HOL/Library/Fset.thy Tue Nov 23 23:10:13 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