Nominal/FSet.thy
changeset 1860 d3fe17786640
parent 1826 faa7e6033f2e
child 1878 c22947214948
equal deleted inserted replaced
1859:900ef226973e 1860:d3fe17786640
    21 
    21 
    22 quotient_type
    22 quotient_type
    23   'a fset = "'a list" / "list_eq"
    23   'a fset = "'a list" / "list_eq"
    24 by (rule list_eq_equivp)
    24 by (rule list_eq_equivp)
    25 
    25 
    26 section {* empty fset, finsert and membership *}
    26 section {* Empty fset, Finsert and Membership *}
    27 
    27 
    28 quotient_definition
    28 quotient_definition
    29   fempty  ("{||}")
    29   fempty  ("{||}")
    30 where
    30 where
    31   "fempty :: 'a fset"
    31   "fempty :: 'a fset"
    53   "fin :: 'a \<Rightarrow> 'a fset \<Rightarrow> bool" is "memb"
    53   "fin :: 'a \<Rightarrow> 'a fset \<Rightarrow> bool" is "memb"
    54 
    54 
    55 abbreviation
    55 abbreviation
    56   fnotin :: "'a \<Rightarrow> 'a fset \<Rightarrow> bool" ("_ |\<notin>| _" [50, 51] 50)
    56   fnotin :: "'a \<Rightarrow> 'a fset \<Rightarrow> bool" ("_ |\<notin>| _" [50, 51] 50)
    57 where
    57 where
    58   "x |\<notin>| S \<equiv> \<not>(x |\<in>| S)"
    58   "x |\<notin>| S \<equiv> \<not> (x |\<in>| S)"
    59 
    59 
    60 lemma memb_rsp[quot_respect]:
    60 lemma memb_rsp[quot_respect]:
    61   shows "(op = ===> op \<approx> ===> op =) memb memb"
    61   shows "(op = ===> op \<approx> ===> op =) memb memb"
    62 by (auto simp add: memb_def)
    62 by (auto simp add: memb_def)
    63 
    63 
    70 by simp
    70 by simp
    71 
    71 
    72 section {* Augmenting an fset -- @{const finsert} *}
    72 section {* Augmenting an fset -- @{const finsert} *}
    73 
    73 
    74 lemma nil_not_cons:
    74 lemma nil_not_cons:
    75   shows
    75   shows "\<not> ([] \<approx> x # xs)"
    76   "\<not> ([] \<approx> x # xs)"
    76   and   "\<not> (x # xs \<approx> [])"
    77   "\<not> (x # xs \<approx> [])"
       
    78   by auto
    77   by auto
    79 
    78 
    80 lemma not_memb_nil:
    79 lemma not_memb_nil:
    81   "\<not> memb x []"
    80   shows "\<not> memb x []"
    82   by (simp add: memb_def)
    81   by (simp add: memb_def)
    83 
    82 
    84 lemma memb_cons_iff:
    83 lemma memb_cons_iff:
    85   shows "memb x (y # xs) = (x = y \<or> memb x xs)"
    84   shows "memb x (y # xs) = (x = y \<or> memb x xs)"
    86   by (induct xs) (auto simp add: memb_def)
    85   by (induct xs) (auto simp add: memb_def)
   101 
   100 
   102 lemma singleton_list_eq:
   101 lemma singleton_list_eq:
   103   shows "[x] \<approx> [y] \<longleftrightarrow> x = y"
   102   shows "[x] \<approx> [y] \<longleftrightarrow> x = y"
   104   by (simp add: id_simps) auto
   103   by (simp add: id_simps) auto
   105 
   104 
   106 section {* Union *}
   105 section {* Unions *}
   107 
   106 
   108 quotient_definition
   107 quotient_definition
   109   funion  (infixl "|\<union>|" 65)
   108   funion  (infixl "|\<union>|" 65)
   110 where
   109 where
   111   "funion :: 'a fset \<Rightarrow> 'a fset \<Rightarrow> 'a fset"
   110   "funion :: 'a fset \<Rightarrow> 'a fset \<Rightarrow> 'a fset"
   124   "fcard :: 'a fset \<Rightarrow> nat" 
   123   "fcard :: 'a fset \<Rightarrow> nat" 
   125 is
   124 is
   126   "fcard_raw"
   125   "fcard_raw"
   127 
   126 
   128 lemma fcard_raw_0:
   127 lemma fcard_raw_0:
   129   fixes xs :: "'a list"
   128   shows "fcard_raw xs = 0 \<longleftrightarrow> xs \<approx> []"
   130   shows "(fcard_raw xs = 0) = (xs \<approx> [])"
       
   131   by (induct xs) (auto simp add: memb_def)
   129   by (induct xs) (auto simp add: memb_def)
   132 
   130 
   133 lemma fcard_raw_gt_0:
   131 lemma fcard_raw_gt_0:
   134   assumes a: "x \<in> set xs"
   132   assumes a: "x \<in> set xs"
   135   shows "0 < fcard_raw xs"
   133   shows "0 < fcard_raw xs"
       
   134   using a by (induct xs) (auto simp add: memb_def)
       
   135 
       
   136 lemma fcard_raw_not_memb:
       
   137   shows "\<not> memb x xs \<longleftrightarrow> fcard_raw (x # xs) = Suc (fcard_raw xs)"
       
   138   by auto
       
   139 
       
   140 lemma fcard_raw_suc:
       
   141   assumes a: "fcard_raw xs = Suc n"
       
   142   shows "\<exists>x ys. \<not> (memb x ys) \<and> xs \<approx> (x # ys) \<and> fcard_raw ys = n"
   136   using a
   143   using a
   137   by (induct xs) (auto simp add: memb_def)
   144   by (induct xs) (auto simp add: memb_def split: if_splits)
   138 
       
   139 lemma fcard_raw_not_memb:
       
   140   fixes x :: "'a"
       
   141   shows "\<not>(memb x xs) \<longleftrightarrow> fcard_raw (x # xs) = Suc (fcard_raw xs)"
       
   142   by auto
       
   143 
       
   144 lemma fcard_raw_suc:
       
   145   fixes xs :: "'a list"
       
   146   assumes c: "fcard_raw xs = Suc n"
       
   147   shows "\<exists>x ys. \<not>(memb x ys) \<and> xs \<approx> (x # ys) \<and> fcard_raw ys = n"
       
   148   unfolding memb_def
       
   149   using c
       
   150   proof (induct xs)
       
   151     case Nil
       
   152     then show ?case by simp
       
   153   next
       
   154     case (Cons a xs)
       
   155     have f1: "fcard_raw xs = Suc n \<Longrightarrow> \<exists>a ys. a \<notin> set ys \<and> xs \<approx> a # ys \<and> fcard_raw ys = n" by fact
       
   156     have f2: "fcard_raw (a # xs) = Suc n" by fact
       
   157     then show ?case proof (cases "a \<in> set xs")
       
   158       case True
       
   159       then show ?thesis using f1 f2 apply -
       
   160         apply (simp add: memb_def)
       
   161         apply clarify
       
   162         by metis
       
   163     next
       
   164       case False
       
   165       then show ?thesis using f1 f2 apply -
       
   166         apply (rule_tac x="a" in exI)
       
   167         apply (rule_tac x="xs" in exI)
       
   168         apply (simp add: memb_def)
       
   169         done
       
   170     qed
       
   171   qed
       
   172 
   145 
   173 lemma singleton_fcard_1: 
   146 lemma singleton_fcard_1: 
   174   shows "set xs = {x} \<Longrightarrow> fcard_raw xs = Suc 0"
   147   shows "set xs = {x} \<Longrightarrow> fcard_raw xs = 1"
   175   apply (induct xs)
   148   by (induct xs) (auto simp add: memb_def subset_insert)
   176   apply simp_all
       
   177   apply auto
       
   178   apply (subgoal_tac "set xs = {x}")
       
   179   apply simp
       
   180   apply (simp add: memb_def)
       
   181   apply auto
       
   182   apply (subgoal_tac "set xs = {}")
       
   183   apply simp
       
   184   by (metis memb_def subset_empty subset_insert)
       
   185 
   149 
   186 lemma fcard_raw_1:
   150 lemma fcard_raw_1:
   187   fixes a :: "'a list"
       
   188   shows "fcard_raw xs = 1 \<longleftrightarrow> (\<exists>x. xs \<approx> [x])"
   151   shows "fcard_raw xs = 1 \<longleftrightarrow> (\<exists>x. xs \<approx> [x])"
   189   apply (auto dest!: fcard_raw_suc)
   152   apply (auto dest!: fcard_raw_suc)
   190   apply (simp add: fcard_raw_0)
   153   apply (simp add: fcard_raw_0)
   191   apply (rule_tac x="x" in exI)
   154   apply (rule_tac x="x" in exI)
   192   apply simp
   155   apply simp
   193   apply (subgoal_tac "set xs = {x}")
   156   apply (subgoal_tac "set xs = {x}")
   194   apply (erule singleton_fcard_1)
   157   apply (drule singleton_fcard_1)
   195   apply auto
   158   apply auto
   196   done
   159   done
   197 
   160 
   198 lemma fcard_raw_delete_one:
   161 lemma fcard_raw_delete_one:
   199   "fcard_raw ([x \<leftarrow> xs. x \<noteq> y]) = (if memb y xs then fcard_raw xs - 1 else fcard_raw xs)"
   162   shows "fcard_raw ([x \<leftarrow> xs. x \<noteq> y]) = (if memb y xs then fcard_raw xs - 1 else fcard_raw xs)"
   200   by (induct xs) (auto dest: fcard_raw_gt_0 simp add: memb_def)
   163   by (induct xs) (auto dest: fcard_raw_gt_0 simp add: memb_def)
   201 
   164 
   202 lemma fcard_raw_rsp_aux:
   165 lemma fcard_raw_rsp_aux:
   203   assumes a: "xs \<approx> ys"
   166   assumes a: "xs \<approx> ys"
   204   shows "fcard_raw xs = fcard_raw ys"
   167   shows "fcard_raw xs = fcard_raw ys"
   210   apply(simp add: fcard_raw_delete_one)
   173   apply(simp add: fcard_raw_delete_one)
   211   apply(metis Suc_pred'[OF fcard_raw_gt_0] fcard_raw_delete_one memb_def)
   174   apply(metis Suc_pred'[OF fcard_raw_gt_0] fcard_raw_delete_one memb_def)
   212   done
   175   done
   213 
   176 
   214 lemma fcard_raw_rsp[quot_respect]:
   177 lemma fcard_raw_rsp[quot_respect]:
   215   "(op \<approx> ===> op =) fcard_raw fcard_raw"
   178   shows "(op \<approx> ===> op =) fcard_raw fcard_raw"
   216   by (simp add: fcard_raw_rsp_aux)
   179   by (simp add: fcard_raw_rsp_aux)
   217 
   180 
   218 
   181 
   219 section {* fmap and fset comprehension *}
   182 section {* fmap and fset comprehension *}
   220 
   183 
   266   apply (rule_tac x="x" in exI)
   229   apply (rule_tac x="x" in exI)
   267   apply (rule_tac x="a # ys" in exI)
   230   apply (rule_tac x="a # ys" in exI)
   268   apply (auto simp add: memb_def)
   231   apply (auto simp add: memb_def)
   269   done
   232   done
   270 
   233 
       
   234 section {* deletion *}
       
   235 
   271 fun
   236 fun
   272   delete_raw :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list"
   237   delete_raw :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list"
   273 where
   238 where
   274   "delete_raw [] x = []"
   239   "delete_raw [] x = []"
   275 | "delete_raw (a # A) x = (if (a = x) then delete_raw A x else a # (delete_raw A x))"
   240 | "delete_raw (a # A) x = (if (a = x) then delete_raw A x else a # (delete_raw A x))"
   277 lemma memb_delete_raw:
   242 lemma memb_delete_raw:
   278   "memb x (delete_raw xs y) = (memb x xs \<and> x \<noteq> y)"
   243   "memb x (delete_raw xs y) = (memb x xs \<and> x \<noteq> y)"
   279   by (induct xs arbitrary: x y) (auto simp add: memb_def)
   244   by (induct xs arbitrary: x y) (auto simp add: memb_def)
   280 
   245 
   281 lemma delete_raw_rsp:
   246 lemma delete_raw_rsp:
   282   "l \<approx> r \<Longrightarrow> delete_raw l x \<approx> delete_raw r x"
   247   "xs \<approx> ys \<Longrightarrow> delete_raw xs x \<approx> delete_raw ys x"
   283   by (simp add: memb_def[symmetric] memb_delete_raw)
   248   by (simp add: memb_def[symmetric] memb_delete_raw)
   284 
   249 
   285 lemma [quot_respect]:
   250 lemma [quot_respect]:
   286   "(op \<approx> ===> op = ===> op \<approx>) delete_raw delete_raw"
   251   "(op \<approx> ===> op = ===> op \<approx>) delete_raw delete_raw"
   287   by (simp add: memb_def[symmetric] memb_delete_raw)
   252   by (simp add: memb_def[symmetric] memb_delete_raw)
   288 
   253 
   289 lemma memb_delete_raw_ident:
   254 lemma memb_delete_raw_ident:
   290   "\<not> memb x (delete_raw xs x)"
   255   shows "\<not> memb x (delete_raw xs x)"
   291   by (induct xs) (auto simp add: memb_def)
   256   by (induct xs) (auto simp add: memb_def)
   292 
   257 
   293 lemma not_memb_delete_raw_ident:
   258 lemma not_memb_delete_raw_ident:
   294   "\<not> memb x xs \<Longrightarrow> delete_raw xs x = xs"
   259   shows "\<not> memb x xs \<Longrightarrow> delete_raw xs x = xs"
   295   by (induct xs) (auto simp add: memb_def)
   260   by (induct xs) (auto simp add: memb_def)
   296 
   261 
   297 lemma fset_raw_delete_raw_cases:
   262 lemma fset_raw_delete_raw_cases:
   298   "xs = [] \<or> (\<exists>x. memb x xs \<and> xs \<approx> x # delete_raw xs x)"
   263   "xs = [] \<or> (\<exists>x. memb x xs \<and> xs \<approx> x # delete_raw xs x)"
   299   by (induct xs) (auto simp add: memb_def)
   264   by (induct xs) (auto simp add: memb_def)
   507 
   472 
   508 lemma fcard_0: "(fcard S = 0) = (S = {||})"
   473 lemma fcard_0: "(fcard S = 0) = (S = {||})"
   509   by (lifting fcard_raw_0)
   474   by (lifting fcard_raw_0)
   510 
   475 
   511 lemma fcard_1:
   476 lemma fcard_1:
   512   fixes S::"'b fset"
       
   513   shows "(fcard S = 1) = (\<exists>x. S = {|x|})"
   477   shows "(fcard S = 1) = (\<exists>x. S = {|x|})"
   514   by (lifting fcard_raw_1)
   478   by (lifting fcard_raw_1)
   515 
   479 
   516 lemma fcard_gt_0: "x \<in> fset_to_set S \<Longrightarrow> 0 < fcard S"
   480 lemma fcard_gt_0: 
       
   481   shows "x \<in> fset_to_set S \<Longrightarrow> 0 < fcard S"
   517   by (lifting fcard_raw_gt_0)
   482   by (lifting fcard_raw_gt_0)
   518 
   483 
   519 lemma fcard_not_fin: "(x |\<notin>| S) = (fcard (finsert x S) = Suc (fcard S))"
   484 lemma fcard_not_fin: 
       
   485   shows "(x |\<notin>| S) = (fcard (finsert x S) = Suc (fcard S))"
   520   by (lifting fcard_raw_not_memb)
   486   by (lifting fcard_raw_not_memb)
   521 
   487 
   522 lemma fcard_suc: "fcard S = Suc n \<Longrightarrow> \<exists>x T. x |\<notin>| T \<and> S = finsert x T \<and> fcard T = n"
   488 lemma fcard_suc: "fcard S = Suc n \<Longrightarrow> \<exists>x T. x |\<notin>| T \<and> S = finsert x T \<and> fcard T = n"
   523   by (lifting fcard_raw_suc)
   489   by (lifting fcard_raw_suc)
   524 
   490 
   527   by (lifting fcard_raw_delete)
   493   by (lifting fcard_raw_delete)
   528 
   494 
   529 text {* funion *}
   495 text {* funion *}
   530 
   496 
   531 lemma funion_simps[simp]:
   497 lemma funion_simps[simp]:
   532   "{||} |\<union>| S = S"
   498   shows "{||} |\<union>| S = S"
   533   "finsert x S |\<union>| T = finsert x (S |\<union>| T)"
   499   and   "finsert x S |\<union>| T = finsert x (S |\<union>| T)"
   534   by (lifting append.simps)
   500   by (lifting append.simps)
   535 
   501 
   536 lemma funion_sym:
   502 lemma funion_sym:
   537   "S |\<union>| T = T |\<union>| S"
   503   shows "S |\<union>| T = T |\<union>| S"
   538   by (lifting funion_sym_pre)
   504   by (lifting funion_sym_pre)
   539 
   505 
   540 lemma funion_assoc:
   506 lemma funion_assoc:
   541  "S |\<union>| T |\<union>| U = S |\<union>| (T |\<union>| U)"
   507   shows "S |\<union>| T |\<union>| U = S |\<union>| (T |\<union>| U)"
   542   by (lifting append_assoc)
   508   by (lifting append_assoc)
   543 
   509 
   544 section {* Induction and Cases rules for finite sets *}
   510 section {* Induction and Cases rules for finite sets *}
   545 
   511 
   546 lemma fset_strong_cases:
   512 lemma fset_strong_cases: