author  huffman 
Sat, 14 Feb 2009 11:10:35 0800  
changeset 29910  623c9c20966b 
parent 29880  3dee8ff45d3d 
child 30663  0b6aff7451b2 
permissions  rwrr 
26169  1 
(* Title: HOL/Library/Countable.thy 
26350  2 
Author: Alexander Krauss, TU Muenchen 
26169  3 
*) 
4 

5 
header {* Encoding (almost) everything into natural numbers *} 

6 

7 
theory Countable 

29880
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

8 
imports 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

9 
Plain 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

10 
"~~/src/HOL/List" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

11 
"~~/src/HOL/Hilbert_Choice" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

12 
"~~/src/HOL/Nat_Int_Bij" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

13 
"~~/src/HOL/Rational" 
26169  14 
begin 
15 

16 
subsection {* The class of countable types *} 

17 

29797  18 
class countable = 
26169  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 

26585  31 
subsection {* Conversion functions *} 
26169  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 

29910  42 
lemma surj_from_nat [simp]: "surj from_nat" 
43 
unfolding from_nat_def by (simp add: inj_imp_surj_inv) 

44 

26169  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 

28823  59 
proof 
26169  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" 

26580
c3e597a476fd
Generic conversion and tactic "atomize_elim" to convert elimination rules
krauss
parents:
26350
diff
changeset

131 
apply atomize_elim 
26169  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 

26243  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 

29880
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

204 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

205 
subsection {* The Rationals are Countably Infinite *} 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

206 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

207 
definition nat_to_rat_surj :: "nat \<Rightarrow> rat" where 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

208 
"nat_to_rat_surj n = (let (a,b) = nat_to_nat2 n 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

209 
in Fract (nat_to_int_bij a) (nat_to_int_bij b))" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

210 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

211 
lemma surj_nat_to_rat_surj: "surj nat_to_rat_surj" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

212 
unfolding surj_def 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

213 
proof 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

214 
fix r::rat 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

215 
show "\<exists>n. r = nat_to_rat_surj n" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

216 
proof(cases r) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

217 
fix i j assume [simp]: "r = Fract i j" and "j \<noteq> 0" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

218 
have "r = (let m = inv nat_to_int_bij i; n = inv nat_to_int_bij j 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

219 
in nat_to_rat_surj(nat2_to_nat (m,n)))" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

220 
using nat2_to_nat_inj surj_f_inv_f[OF surj_nat_to_int_bij] 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

221 
by(simp add:Let_def nat_to_rat_surj_def nat_to_nat2_def) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

222 
thus "\<exists>n. r = nat_to_rat_surj n" by(auto simp:Let_def) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

223 
qed 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

224 
qed 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

225 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

226 
lemma Rats_eq_range_nat_to_rat_surj: "\<rat> = range nat_to_rat_surj" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

227 
by (simp add: Rats_def surj_nat_to_rat_surj surj_range) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

228 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

229 
context field_char_0 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

230 
begin 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

231 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

232 
lemma Rats_eq_range_of_rat_o_nat_to_rat_surj: 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

233 
"\<rat> = range (of_rat o nat_to_rat_surj)" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

234 
using surj_nat_to_rat_surj 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

235 
by (auto simp: Rats_def image_def surj_def) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

236 
(blast intro: arg_cong[where f = of_rat]) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

237 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

238 
lemma surj_of_rat_nat_to_rat_surj: 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

239 
"r\<in>\<rat> \<Longrightarrow> \<exists>n. r = of_rat(nat_to_rat_surj n)" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

240 
by(simp add: Rats_eq_range_of_rat_o_nat_to_rat_surj image_def) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

241 

26169  242 
end 
29880
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

243 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

244 
instance rat :: countable 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

245 
proof 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

246 
show "\<exists>to_nat::rat \<Rightarrow> nat. inj to_nat" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

247 
proof 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

248 
have "surj nat_to_rat_surj" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

249 
by (rule surj_nat_to_rat_surj) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

250 
then show "inj (inv nat_to_rat_surj)" 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

251 
by (rule surj_imp_inj_inv) 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

252 
qed 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

253 
qed 
3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

254 

3dee8ff45d3d
move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents:
29797
diff
changeset

255 
end 