added theory for countable types
authorhaftmann
Wed Feb 27 21:41:07 2008 +0100 (2008-02-27)
changeset 2616973027318f9ba
parent 26168 3bd9ac4e0b97
child 26170 66e6b967ccf1
added theory for countable types
src/HOL/Library/Countable.thy
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/HOL/Library/Countable.thy	Wed Feb 27 21:41:07 2008 +0100
     1.3 @@ -0,0 +1,183 @@
     1.4 +(*  Title:      HOL/Library/Countable.thy
     1.5 +    ID:         $Id$
     1.6 +    Author:     Tobias Nipkow
     1.7 +*)
     1.8 +
     1.9 +header {* Encoding (almost) everything into natural numbers *}
    1.10 +
    1.11 +theory Countable
    1.12 +imports Finite_Set List Hilbert_Choice
    1.13 +begin
    1.14 +
    1.15 +subsection {* The class of countable types *}
    1.16 +
    1.17 +class countable = itself +
    1.18 +  assumes ex_inj: "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat"
    1.19 +
    1.20 +lemma countable_classI:
    1.21 +  fixes f :: "'a \<Rightarrow> nat"
    1.22 +  assumes "\<And>x y. f x = f y \<Longrightarrow> x = y"
    1.23 +  shows "OFCLASS('a, countable_class)"
    1.24 +proof (intro_classes, rule exI)
    1.25 +  show "inj f"
    1.26 +    by (rule injI [OF assms]) assumption
    1.27 +qed
    1.28 +
    1.29 +
    1.30 +subsection {* Converion functions *}
    1.31 +
    1.32 +definition to_nat :: "'a\<Colon>countable \<Rightarrow> nat" where
    1.33 +  "to_nat = (SOME f. inj f)"
    1.34 +
    1.35 +definition from_nat :: "nat \<Rightarrow> 'a\<Colon>countable" where
    1.36 +  "from_nat = inv (to_nat \<Colon> 'a \<Rightarrow> nat)"
    1.37 +
    1.38 +lemma inj_to_nat [simp]: "inj to_nat"
    1.39 +  by (rule exE_some [OF ex_inj]) (simp add: to_nat_def)
    1.40 +
    1.41 +lemma to_nat_split [simp]: "to_nat x = to_nat y \<longleftrightarrow> x = y"
    1.42 +  using injD [OF inj_to_nat] by auto
    1.43 +
    1.44 +lemma from_nat_to_nat [simp]:
    1.45 +  "from_nat (to_nat x) = x"
    1.46 +  by (simp add: from_nat_def)
    1.47 +
    1.48 +
    1.49 +subsection {* Countable types *}
    1.50 +
    1.51 +instance nat :: countable
    1.52 +  by (rule countable_classI [of "id"]) simp 
    1.53 +
    1.54 +subclass (in finite) countable
    1.55 +proof unfold_locales
    1.56 +  have "finite (UNIV\<Colon>'a set)" by (rule finite_UNIV)
    1.57 +  with finite_conv_nat_seg_image [of UNIV]
    1.58 +  obtain n and f :: "nat \<Rightarrow> 'a" 
    1.59 +    where "UNIV = f ` {i. i < n}" by auto
    1.60 +  then have "surj f" unfolding surj_def by auto
    1.61 +  then have "inj (inv f)" by (rule surj_imp_inj_inv)
    1.62 +  then show "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat" by (rule exI[of inj])
    1.63 +qed
    1.64 +
    1.65 +text {* Pairs *}
    1.66 +
    1.67 +primrec sum :: "nat \<Rightarrow> nat"
    1.68 +where
    1.69 +  "sum 0 = 0"
    1.70 +| "sum (Suc n) = Suc n + sum n"
    1.71 +
    1.72 +lemma sum_arith: "sum n = n * Suc n div 2"
    1.73 +  by (induct n) auto
    1.74 +
    1.75 +lemma sum_mono: "n \<ge> m \<Longrightarrow> sum n \<ge> sum m"
    1.76 +  by (induct n m rule: diff_induct) auto
    1.77 +
    1.78 +definition
    1.79 +  "pair_encode = (\<lambda>(m, n). sum (m + n) + m)"
    1.80 +
    1.81 +lemma inj_pair_cencode: "inj pair_encode"
    1.82 +  unfolding pair_encode_def
    1.83 +proof (rule injI, simp only: split_paired_all split_conv)
    1.84 +  fix a b c d
    1.85 +  assume eq: "sum (a + b) + a = sum (c + d) + c"
    1.86 +  have "a + b = c + d \<or> a + b \<ge> Suc (c + d) \<or> c + d \<ge> Suc (a + b)" by arith
    1.87 +  then
    1.88 +  show "(a, b) = (c, d)"
    1.89 +  proof (elim disjE)
    1.90 +    assume sumeq: "a + b = c + d"
    1.91 +    then have "a = c" using eq by auto
    1.92 +    moreover from sumeq this have "b = d" by auto
    1.93 +    ultimately show ?thesis by simp
    1.94 +  next
    1.95 +    assume "a + b \<ge> Suc (c + d)"
    1.96 +    from sum_mono[OF this] eq
    1.97 +    show ?thesis by auto
    1.98 +  next
    1.99 +    assume "c + d \<ge> Suc (a + b)"
   1.100 +    from sum_mono[OF this] eq
   1.101 +    show ?thesis by auto
   1.102 +  qed
   1.103 +qed
   1.104 +
   1.105 +instance "*" :: (countable, countable) countable
   1.106 +by (rule countable_classI [of "\<lambda>(x, y). pair_encode (to_nat x, to_nat y)"])
   1.107 +  (auto dest: injD [OF inj_pair_cencode] injD [OF inj_to_nat])
   1.108 +
   1.109 +
   1.110 +text {* Sums *}
   1.111 +
   1.112 +instance "+":: (countable, countable) countable
   1.113 +  by (rule countable_classI [of "(\<lambda>x. case x of Inl a \<Rightarrow> to_nat (False, to_nat a)
   1.114 +                                     | Inr b \<Rightarrow> to_nat (True, to_nat b))"])
   1.115 +    (auto split:sum.splits)
   1.116 +
   1.117 +
   1.118 +text {* Integers *}
   1.119 +
   1.120 +lemma int_cases: "(i::int) = 0 \<or> i < 0 \<or> i > 0"
   1.121 +by presburger
   1.122 +
   1.123 +lemma int_pos_neg_zero:
   1.124 +  obtains (zero) "(z::int) = 0" "sgn z = 0" "abs z = 0"
   1.125 +  | (pos) n where "z = of_nat n" "sgn z = 1" "abs z = of_nat n"
   1.126 +  | (neg) n where "z = - (of_nat n)" "sgn z = -1" "abs z = of_nat n"
   1.127 +apply elim_to_cases
   1.128 +apply (insert int_cases[of z])
   1.129 +apply (auto simp:zsgn_def)
   1.130 +apply (rule_tac x="nat (-z)" in exI, simp)
   1.131 +apply (rule_tac x="nat z" in exI, simp)
   1.132 +done
   1.133 +
   1.134 +instance int :: countable
   1.135 +proof (rule countable_classI [of "(\<lambda>i. to_nat (nat (sgn i + 1), nat (abs i)))"], 
   1.136 +    auto dest: injD [OF inj_to_nat])
   1.137 +  fix x y 
   1.138 +  assume a: "nat (sgn x + 1) = nat (sgn y + 1)" "nat (abs x) = nat (abs y)"
   1.139 +  show "x = y"
   1.140 +  proof (cases rule: int_pos_neg_zero[of x])
   1.141 +    case zero 
   1.142 +    with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
   1.143 +  next
   1.144 +    case (pos n)
   1.145 +    with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
   1.146 +  next
   1.147 +    case (neg n)
   1.148 +    with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
   1.149 +  qed
   1.150 +qed
   1.151 +
   1.152 +
   1.153 +text {* Options *}
   1.154 +
   1.155 +instance option :: (countable) countable
   1.156 +by (rule countable_classI[of "\<lambda>x. case x of None \<Rightarrow> 0
   1.157 +                                     | Some y \<Rightarrow> Suc (to_nat y)"])
   1.158 + (auto split:option.splits)
   1.159 +
   1.160 +
   1.161 +text {* Lists *}
   1.162 +
   1.163 +lemma from_nat_to_nat_map [simp]: "map from_nat (map to_nat xs) = xs"
   1.164 +  by (simp add: comp_def map_compose [symmetric])
   1.165 +
   1.166 +primrec
   1.167 +  list_encode :: "'a\<Colon>countable list \<Rightarrow> nat"
   1.168 +where
   1.169 +  "list_encode [] = 0"
   1.170 +| "list_encode (x#xs) = Suc (to_nat (x, list_encode xs))"
   1.171 +
   1.172 +instance list :: (countable) countable
   1.173 +proof (rule countable_classI [of "list_encode"])
   1.174 +  fix xs ys :: "'a list"
   1.175 +  assume cenc: "list_encode xs = list_encode ys"
   1.176 +  then show "xs = ys"
   1.177 +  proof (induct xs arbitrary: ys)
   1.178 +    case (Nil ys)
   1.179 +    with cenc show ?case by (cases ys, auto)
   1.180 +  next
   1.181 +    case (Cons x xs' ys)
   1.182 +    thus ?case by (cases ys) auto
   1.183 +  qed
   1.184 +qed
   1.185 +
   1.186 +end