diff -r 7b74d77a61aa -r d5fce1ead432 Quot/Examples/FSet3.thy --- a/Quot/Examples/FSet3.thy Fri Dec 11 17:03:52 2009 +0100 +++ b/Quot/Examples/FSet3.thy Fri Dec 11 19:19:24 2009 +0100 @@ -2,82 +2,89 @@ imports "../QuotMain" List begin -definition +fun list_eq :: "'a list \ 'a list \ bool" (infix "\" 50) where - "list_eq x y = (\e. e mem x = e mem y)" - -lemma list_eq_reflp: - shows "xs \ xs" - by (metis list_eq_def) + "list_eq xs ys = (\e. (e \ set xs) = (e \ set ys))" lemma list_eq_equivp: shows "equivp list_eq" - unfolding equivp_reflp_symp_transp reflp_def symp_def transp_def - apply (auto intro: list_eq_def) - apply (metis list_eq_def) - apply (metis list_eq_def) - sorry +unfolding equivp_reflp_symp_transp reflp_def symp_def transp_def +by auto quotient fset = "'a list" / "list_eq" by (rule list_eq_equivp) -lemma not_nil_equiv_cons: "\[] \ a # A" sorry +lemma not_nil_equiv_cons: + "\[] \ a # A" +by auto -(* The 2 lemmas below are different from the ones in QuotList *) lemma nil_rsp[quot_respect]: shows "[] \ []" -by (rule list_eq_reflp) + by simp -lemma cons_rsp[quot_respect]: (* Better then the one from QuotList *) - " (op = ===> op \ ===> op \) op # op #" - sorry +lemma cons_rsp[quot_respect]: + shows "(op = ===> op \ ===> op \) op # op #" + by simp +(* lemma mem_rsp[quot_respect]: "(op = ===> op \ ===> op =) (op mem) (op mem)" - sorry +*) + -lemma no_mem_nil: "(\a. \(a mem A)) = (A = [])" -sorry +lemma no_mem_nil: + "(\a. \(a \ set A)) = (A = [])" +by (induct A) (auto) -lemma none_mem_nil: "(\a. \(a mem A)) = (A \ [])" -sorry +lemma none_mem_nil: + "(\a. \(a \ set A)) = (A \ [])" +by simp -lemma mem_cons: "a mem A \ a # A \ A" -sorry +lemma mem_cons: + "a \ set A \ a # A \ A" +by auto -lemma cons_left_comm: "x # y # A \ y # x # A" -sorry +lemma cons_left_comm: + "x #y # A \ y # x # A" +by auto -lemma cons_left_idem: "x # x # A \ x # A" -sorry +lemma cons_left_idem: + "x # x # A \ x # A" +by auto lemma finite_set_raw_strong_cases: "(X = []) \ (\a. \ Y. (~(a mem Y) \ (X \ a # Y)))" apply (induct X) - apply (simp) + apply (auto) sorry -primrec +fun delete_raw :: "'a list \ 'a \ 'a list" where "delete_raw [] x = []" | "delete_raw (a # A) x = (if (a = x) then delete_raw A x else a # (delete_raw A x))" +(* definitely FALSE lemma mem_delete_raw: "x mem (delete_raw A a) = x mem A \ \(x = a)" +apply(induct A arbitrary: x a) +apply(auto) sorry +*) lemma mem_delete_raw_ident: - "\(MEM a (A delete_raw a))" -sorry + "\(a \ set (delete_raw A a))" +by (induct A) (auto) lemma not_mem_delete_raw_ident: - "\(b mem A) \ (delete_raw A b = A)" -sorry + "b \ set A \ (delete_raw A b = A)" +by (induct A) (auto) lemma delete_raw_RSP: "A \ B \ delete_raw A a \ delete_raw B a" +apply(induct A arbitrary: B a) +apply(auto) sorry lemma cons_delete_raw: @@ -115,9 +122,11 @@ shows "\a ys. \(a mem ys) \ xs \ (a # ys)" using c apply(induct xs) -apply(metis mem_delete_raw) +(*apply(metis mem_delete_raw) apply(metis mem_delete_raw) -done +done*) +sorry + lemma mem_card_raw_not_0: "a mem A \ \(card_raw A = 0)" @@ -174,13 +183,12 @@ lemma fold_rsp[quot_respect]: "(op = ===> op = ===> op \ ===> op =) fold_raw fold_raw" - apply (auto) - apply (case_tac "rsp_fold x") +apply(auto) sorry lemma append_rsp[quot_respect]: "(op \ ===> op \ ===> op \) op @ op @" - sorry +by auto primrec inter_raw @@ -199,44 +207,61 @@ (* LIFTING DEFS *) + +section {* Constants on the Quotient Type *} + quotient_def - "Empty :: 'a fset" as "[]::'a list" + "fempty :: 'a fset" + as "[]::'a list" quotient_def - "Insert :: 'a \ 'a fset \ 'a fset" as "op #" + "finsert :: 'a \ 'a fset \ 'a fset" + as "op #" quotient_def - "In :: 'a \ 'a fset \ bool" as "op mem" + "fin :: 'a \ 'a fset \ bool" ("_ \f _" [50, 51] 50) + as "\x X. x \ set X" -quotient_def - "Card :: 'a fset \ nat" as "card_raw" +abbreviation + fnotin :: "'a \ 'a fset \ bool" ("_ \f _" [50, 51] 50) +where + "a \f S \ \(a \f S)" quotient_def - "Delete :: 'a fset \ 'a \ 'a fset" as "delete_raw" + "fcard :: 'a fset \ nat" + as "card_raw" quotient_def - "funion :: 'a fset \ 'a fset \ 'a fset" as "op @" + "fdelete :: 'a fset \ 'a \ 'a fset" + as "delete_raw" + +quotient_def + "funion :: 'a fset \ 'a fset \ 'a fset" ("_ \f _" [50, 51] 50) + as "op @" quotient_def - "finter :: 'a fset \ 'a fset \ 'a fset" as "inter_raw" + "finter :: 'a fset \ 'a fset \ 'a fset" ("_ \f _" [70, 71] 70) + as "inter_raw" quotient_def - "ffold :: ('a \ 'b \ 'b) \ 'b \ 'a fset \ 'b" as "fold_raw" + "ffold :: ('a \ 'b \ 'b) \ 'b \ 'a fset \ 'b" + as "fold_raw" quotient_def - "fset_to_set :: 'a fset \ 'a set" as "set" + "fset_to_set :: 'a fset \ 'a set" + as "set" -(* LIFTING THMS *) +section {* Lifted Theorems *} thm list.cases (* ??? *) thm cons_left_comm -lemma "Insert a (Insert b x) = Insert b (Insert a x)" +lemma "finsert a (finsert b S) = finsert b (finsert a S)" by (lifting cons_left_comm) thm cons_left_idem -lemma "Insert a (Insert a x) = Insert a x" +lemma "finsert a (finsert a S) = finsert a S" by (lifting cons_left_idem) (* thm MEM: @@ -248,14 +273,16 @@ thm card_raw.simps thm not_mem_card_raw thm card_raw_suc -lemma "Card x = Suc n \ (\a b. \ In a b & x = Insert a b)" -by (lifting card_raw_suc) + +lemma "fcard X = Suc n \ (\a S. a \f S & X = finsert a S)" +(*by (lifting card_raw_suc)*) +sorry thm card_raw_cons_gt_0 thm mem_card_raw_not_0 thm not_nil_equiv_cons thm delete_raw.simps -thm mem_delete_raw +(*thm mem_delete_raw*) thm card_raw_delete_raw thm cons_delete_raw thm mem_cons_delete_raw @@ -268,7 +295,7 @@ thm list2set_thm thm list_eq_def thm list.induct -lemma "\P Empty; \a x. P x \ P (Insert a x)\ \ P l" +lemma "\P fempty; \a x. P x \ P (finsert a x)\ \ P l" by (lifting list.induct) (* We also have map and some properties of it in FSet *) @@ -287,7 +314,7 @@ apply (auto) sorry -lemma "fset_case (f1::'t) f2 (Insert a xa) = f2 a xa" +lemma "fset_case (f1::'t) f2 (finsert a xa) = f2 a xa" apply (lifting list.cases(2)) done