author | wenzelm |
Mon, 16 Mar 2009 18:24:30 +0100 | |
changeset 30549 | d2d7874648bd |
parent 29910 | 623c9c20966b |
child 30663 | 0b6aff7451b2 |
permissions | -rw-r--r-- |
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 |