src/HOL/Library/Countable.thy
author huffman
Sat Feb 14 11:10:35 2009 -0800 (2009-02-14)
changeset 29910 623c9c20966b
parent 29880 3dee8ff45d3d
child 30663 0b6aff7451b2
permissions -rw-r--r--
add lemma surj_from_nat
     1 (*  Title:      HOL/Library/Countable.thy
     2     Author:     Alexander Krauss, TU Muenchen
     3 *)
     4 
     5 header {* Encoding (almost) everything into natural numbers *}
     6 
     7 theory Countable
     8 imports
     9   Plain
    10   "~~/src/HOL/List"
    11   "~~/src/HOL/Hilbert_Choice"
    12   "~~/src/HOL/Nat_Int_Bij"
    13   "~~/src/HOL/Rational"
    14 begin
    15 
    16 subsection {* The class of countable types *}
    17 
    18 class countable =
    19   assumes ex_inj: "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat"
    20 
    21 lemma countable_classI:
    22   fixes f :: "'a \<Rightarrow> nat"
    23   assumes "\<And>x y. f x = f y \<Longrightarrow> x = y"
    24   shows "OFCLASS('a, countable_class)"
    25 proof (intro_classes, rule exI)
    26   show "inj f"
    27     by (rule injI [OF assms]) assumption
    28 qed
    29 
    30 
    31 subsection {* Conversion functions *}
    32 
    33 definition to_nat :: "'a\<Colon>countable \<Rightarrow> nat" where
    34   "to_nat = (SOME f. inj f)"
    35 
    36 definition from_nat :: "nat \<Rightarrow> 'a\<Colon>countable" where
    37   "from_nat = inv (to_nat \<Colon> 'a \<Rightarrow> nat)"
    38 
    39 lemma inj_to_nat [simp]: "inj to_nat"
    40   by (rule exE_some [OF ex_inj]) (simp add: to_nat_def)
    41 
    42 lemma surj_from_nat [simp]: "surj from_nat"
    43   unfolding from_nat_def by (simp add: inj_imp_surj_inv)
    44 
    45 lemma to_nat_split [simp]: "to_nat x = to_nat y \<longleftrightarrow> x = y"
    46   using injD [OF inj_to_nat] by auto
    47 
    48 lemma from_nat_to_nat [simp]:
    49   "from_nat (to_nat x) = x"
    50   by (simp add: from_nat_def)
    51 
    52 
    53 subsection {* Countable types *}
    54 
    55 instance nat :: countable
    56   by (rule countable_classI [of "id"]) simp 
    57 
    58 subclass (in finite) countable
    59 proof
    60   have "finite (UNIV\<Colon>'a set)" by (rule finite_UNIV)
    61   with finite_conv_nat_seg_image [of UNIV]
    62   obtain n and f :: "nat \<Rightarrow> 'a" 
    63     where "UNIV = f ` {i. i < n}" by auto
    64   then have "surj f" unfolding surj_def by auto
    65   then have "inj (inv f)" by (rule surj_imp_inj_inv)
    66   then show "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat" by (rule exI[of inj])
    67 qed
    68 
    69 text {* Pairs *}
    70 
    71 primrec sum :: "nat \<Rightarrow> nat"
    72 where
    73   "sum 0 = 0"
    74 | "sum (Suc n) = Suc n + sum n"
    75 
    76 lemma sum_arith: "sum n = n * Suc n div 2"
    77   by (induct n) auto
    78 
    79 lemma sum_mono: "n \<ge> m \<Longrightarrow> sum n \<ge> sum m"
    80   by (induct n m rule: diff_induct) auto
    81 
    82 definition
    83   "pair_encode = (\<lambda>(m, n). sum (m + n) + m)"
    84 
    85 lemma inj_pair_cencode: "inj pair_encode"
    86   unfolding pair_encode_def
    87 proof (rule injI, simp only: split_paired_all split_conv)
    88   fix a b c d
    89   assume eq: "sum (a + b) + a = sum (c + d) + c"
    90   have "a + b = c + d \<or> a + b \<ge> Suc (c + d) \<or> c + d \<ge> Suc (a + b)" by arith
    91   then
    92   show "(a, b) = (c, d)"
    93   proof (elim disjE)
    94     assume sumeq: "a + b = c + d"
    95     then have "a = c" using eq by auto
    96     moreover from sumeq this have "b = d" by auto
    97     ultimately show ?thesis by simp
    98   next
    99     assume "a + b \<ge> Suc (c + d)"
   100     from sum_mono[OF this] eq
   101     show ?thesis by auto
   102   next
   103     assume "c + d \<ge> Suc (a + b)"
   104     from sum_mono[OF this] eq
   105     show ?thesis by auto
   106   qed
   107 qed
   108 
   109 instance "*" :: (countable, countable) countable
   110 by (rule countable_classI [of "\<lambda>(x, y). pair_encode (to_nat x, to_nat y)"])
   111   (auto dest: injD [OF inj_pair_cencode] injD [OF inj_to_nat])
   112 
   113 
   114 text {* Sums *}
   115 
   116 instance "+":: (countable, countable) countable
   117   by (rule countable_classI [of "(\<lambda>x. case x of Inl a \<Rightarrow> to_nat (False, to_nat a)
   118                                      | Inr b \<Rightarrow> to_nat (True, to_nat b))"])
   119     (auto split:sum.splits)
   120 
   121 
   122 text {* Integers *}
   123 
   124 lemma int_cases: "(i::int) = 0 \<or> i < 0 \<or> i > 0"
   125 by presburger
   126 
   127 lemma int_pos_neg_zero:
   128   obtains (zero) "(z::int) = 0" "sgn z = 0" "abs z = 0"
   129   | (pos) n where "z = of_nat n" "sgn z = 1" "abs z = of_nat n"
   130   | (neg) n where "z = - (of_nat n)" "sgn z = -1" "abs z = of_nat n"
   131 apply atomize_elim
   132 apply (insert int_cases[of z])
   133 apply (auto simp:zsgn_def)
   134 apply (rule_tac x="nat (-z)" in exI, simp)
   135 apply (rule_tac x="nat z" in exI, simp)
   136 done
   137 
   138 instance int :: countable
   139 proof (rule countable_classI [of "(\<lambda>i. to_nat (nat (sgn i + 1), nat (abs i)))"], 
   140     auto dest: injD [OF inj_to_nat])
   141   fix x y 
   142   assume a: "nat (sgn x + 1) = nat (sgn y + 1)" "nat (abs x) = nat (abs y)"
   143   show "x = y"
   144   proof (cases rule: int_pos_neg_zero[of x])
   145     case zero 
   146     with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
   147   next
   148     case (pos n)
   149     with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
   150   next
   151     case (neg n)
   152     with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
   153   qed
   154 qed
   155 
   156 
   157 text {* Options *}
   158 
   159 instance option :: (countable) countable
   160 by (rule countable_classI[of "\<lambda>x. case x of None \<Rightarrow> 0
   161                                      | Some y \<Rightarrow> Suc (to_nat y)"])
   162  (auto split:option.splits)
   163 
   164 
   165 text {* Lists *}
   166 
   167 lemma from_nat_to_nat_map [simp]: "map from_nat (map to_nat xs) = xs"
   168   by (simp add: comp_def map_compose [symmetric])
   169 
   170 primrec
   171   list_encode :: "'a\<Colon>countable list \<Rightarrow> nat"
   172 where
   173   "list_encode [] = 0"
   174 | "list_encode (x#xs) = Suc (to_nat (x, list_encode xs))"
   175 
   176 instance list :: (countable) countable
   177 proof (rule countable_classI [of "list_encode"])
   178   fix xs ys :: "'a list"
   179   assume cenc: "list_encode xs = list_encode ys"
   180   then show "xs = ys"
   181   proof (induct xs arbitrary: ys)
   182     case (Nil ys)
   183     with cenc show ?case by (cases ys, auto)
   184   next
   185     case (Cons x xs' ys)
   186     thus ?case by (cases ys) auto
   187   qed
   188 qed
   189 
   190 
   191 text {* Functions *}
   192 
   193 instance "fun" :: (finite, countable) countable
   194 proof
   195   obtain xs :: "'a list" where xs: "set xs = UNIV"
   196     using finite_list [OF finite_UNIV] ..
   197   show "\<exists>to_nat::('a \<Rightarrow> 'b) \<Rightarrow> nat. inj to_nat"
   198   proof
   199     show "inj (\<lambda>f. to_nat (map f xs))"
   200       by (rule injI, simp add: xs expand_fun_eq)
   201   qed
   202 qed
   203 
   204 
   205 subsection {* The Rationals are Countably Infinite *}
   206 
   207 definition nat_to_rat_surj :: "nat \<Rightarrow> rat" where
   208 "nat_to_rat_surj n = (let (a,b) = nat_to_nat2 n
   209                       in Fract (nat_to_int_bij a) (nat_to_int_bij b))"
   210 
   211 lemma surj_nat_to_rat_surj: "surj nat_to_rat_surj"
   212 unfolding surj_def
   213 proof
   214   fix r::rat
   215   show "\<exists>n. r = nat_to_rat_surj n"
   216   proof(cases r)
   217     fix i j assume [simp]: "r = Fract i j" and "j \<noteq> 0"
   218     have "r = (let m = inv nat_to_int_bij i; n = inv nat_to_int_bij j
   219                in nat_to_rat_surj(nat2_to_nat (m,n)))"
   220       using nat2_to_nat_inj surj_f_inv_f[OF surj_nat_to_int_bij]
   221       by(simp add:Let_def nat_to_rat_surj_def nat_to_nat2_def)
   222     thus "\<exists>n. r = nat_to_rat_surj n" by(auto simp:Let_def)
   223   qed
   224 qed
   225 
   226 lemma Rats_eq_range_nat_to_rat_surj: "\<rat> = range nat_to_rat_surj"
   227 by (simp add: Rats_def surj_nat_to_rat_surj surj_range)
   228 
   229 context field_char_0
   230 begin
   231 
   232 lemma Rats_eq_range_of_rat_o_nat_to_rat_surj:
   233   "\<rat> = range (of_rat o nat_to_rat_surj)"
   234 using surj_nat_to_rat_surj
   235 by (auto simp: Rats_def image_def surj_def)
   236    (blast intro: arg_cong[where f = of_rat])
   237 
   238 lemma surj_of_rat_nat_to_rat_surj:
   239   "r\<in>\<rat> \<Longrightarrow> \<exists>n. r = of_rat(nat_to_rat_surj n)"
   240 by(simp add: Rats_eq_range_of_rat_o_nat_to_rat_surj image_def)
   241 
   242 end
   243 
   244 instance rat :: countable
   245 proof
   246   show "\<exists>to_nat::rat \<Rightarrow> nat. inj to_nat"
   247   proof
   248     have "surj nat_to_rat_surj"
   249       by (rule surj_nat_to_rat_surj)
   250     then show "inj (inv nat_to_rat_surj)"
   251       by (rule surj_imp_inj_inv)
   252   qed
   253 qed
   254 
   255 end