haftmann@26169
|
1 |
(* Title: HOL/Library/Countable.thy
|
haftmann@26169
|
2 |
ID: $Id$
|
haftmann@26350
|
3 |
Author: Alexander Krauss, TU Muenchen
|
haftmann@26169
|
4 |
*)
|
haftmann@26169
|
5 |
|
haftmann@26169
|
6 |
header {* Encoding (almost) everything into natural numbers *}
|
haftmann@26169
|
7 |
|
haftmann@26169
|
8 |
theory Countable
|
haftmann@27487
|
9 |
imports Plain "~~/src/HOL/List" "~~/src/HOL/Hilbert_Choice"
|
haftmann@26169
|
10 |
begin
|
haftmann@26169
|
11 |
|
haftmann@26169
|
12 |
subsection {* The class of countable types *}
|
haftmann@26169
|
13 |
|
haftmann@26169
|
14 |
class countable = itself +
|
haftmann@26169
|
15 |
assumes ex_inj: "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat"
|
haftmann@26169
|
16 |
|
haftmann@26169
|
17 |
lemma countable_classI:
|
haftmann@26169
|
18 |
fixes f :: "'a \<Rightarrow> nat"
|
haftmann@26169
|
19 |
assumes "\<And>x y. f x = f y \<Longrightarrow> x = y"
|
haftmann@26169
|
20 |
shows "OFCLASS('a, countable_class)"
|
haftmann@26169
|
21 |
proof (intro_classes, rule exI)
|
haftmann@26169
|
22 |
show "inj f"
|
haftmann@26169
|
23 |
by (rule injI [OF assms]) assumption
|
haftmann@26169
|
24 |
qed
|
haftmann@26169
|
25 |
|
haftmann@26169
|
26 |
|
huffman@26585
|
27 |
subsection {* Conversion functions *}
|
haftmann@26169
|
28 |
|
haftmann@26169
|
29 |
definition to_nat :: "'a\<Colon>countable \<Rightarrow> nat" where
|
haftmann@26169
|
30 |
"to_nat = (SOME f. inj f)"
|
haftmann@26169
|
31 |
|
haftmann@26169
|
32 |
definition from_nat :: "nat \<Rightarrow> 'a\<Colon>countable" where
|
haftmann@26169
|
33 |
"from_nat = inv (to_nat \<Colon> 'a \<Rightarrow> nat)"
|
haftmann@26169
|
34 |
|
haftmann@26169
|
35 |
lemma inj_to_nat [simp]: "inj to_nat"
|
haftmann@26169
|
36 |
by (rule exE_some [OF ex_inj]) (simp add: to_nat_def)
|
haftmann@26169
|
37 |
|
haftmann@26169
|
38 |
lemma to_nat_split [simp]: "to_nat x = to_nat y \<longleftrightarrow> x = y"
|
haftmann@26169
|
39 |
using injD [OF inj_to_nat] by auto
|
haftmann@26169
|
40 |
|
haftmann@26169
|
41 |
lemma from_nat_to_nat [simp]:
|
haftmann@26169
|
42 |
"from_nat (to_nat x) = x"
|
haftmann@26169
|
43 |
by (simp add: from_nat_def)
|
haftmann@26169
|
44 |
|
haftmann@26169
|
45 |
|
haftmann@26169
|
46 |
subsection {* Countable types *}
|
haftmann@26169
|
47 |
|
haftmann@26169
|
48 |
instance nat :: countable
|
haftmann@26169
|
49 |
by (rule countable_classI [of "id"]) simp
|
haftmann@26169
|
50 |
|
haftmann@26169
|
51 |
subclass (in finite) countable
|
haftmann@26169
|
52 |
proof unfold_locales
|
haftmann@26169
|
53 |
have "finite (UNIV\<Colon>'a set)" by (rule finite_UNIV)
|
haftmann@26169
|
54 |
with finite_conv_nat_seg_image [of UNIV]
|
haftmann@26169
|
55 |
obtain n and f :: "nat \<Rightarrow> 'a"
|
haftmann@26169
|
56 |
where "UNIV = f ` {i. i < n}" by auto
|
haftmann@26169
|
57 |
then have "surj f" unfolding surj_def by auto
|
haftmann@26169
|
58 |
then have "inj (inv f)" by (rule surj_imp_inj_inv)
|
haftmann@26169
|
59 |
then show "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat" by (rule exI[of inj])
|
haftmann@26169
|
60 |
qed
|
haftmann@26169
|
61 |
|
haftmann@26169
|
62 |
text {* Pairs *}
|
haftmann@26169
|
63 |
|
haftmann@26169
|
64 |
primrec sum :: "nat \<Rightarrow> nat"
|
haftmann@26169
|
65 |
where
|
haftmann@26169
|
66 |
"sum 0 = 0"
|
haftmann@26169
|
67 |
| "sum (Suc n) = Suc n + sum n"
|
haftmann@26169
|
68 |
|
haftmann@26169
|
69 |
lemma sum_arith: "sum n = n * Suc n div 2"
|
haftmann@26169
|
70 |
by (induct n) auto
|
haftmann@26169
|
71 |
|
haftmann@26169
|
72 |
lemma sum_mono: "n \<ge> m \<Longrightarrow> sum n \<ge> sum m"
|
haftmann@26169
|
73 |
by (induct n m rule: diff_induct) auto
|
haftmann@26169
|
74 |
|
haftmann@26169
|
75 |
definition
|
haftmann@26169
|
76 |
"pair_encode = (\<lambda>(m, n). sum (m + n) + m)"
|
haftmann@26169
|
77 |
|
haftmann@26169
|
78 |
lemma inj_pair_cencode: "inj pair_encode"
|
haftmann@26169
|
79 |
unfolding pair_encode_def
|
haftmann@26169
|
80 |
proof (rule injI, simp only: split_paired_all split_conv)
|
haftmann@26169
|
81 |
fix a b c d
|
haftmann@26169
|
82 |
assume eq: "sum (a + b) + a = sum (c + d) + c"
|
haftmann@26169
|
83 |
have "a + b = c + d \<or> a + b \<ge> Suc (c + d) \<or> c + d \<ge> Suc (a + b)" by arith
|
haftmann@26169
|
84 |
then
|
haftmann@26169
|
85 |
show "(a, b) = (c, d)"
|
haftmann@26169
|
86 |
proof (elim disjE)
|
haftmann@26169
|
87 |
assume sumeq: "a + b = c + d"
|
haftmann@26169
|
88 |
then have "a = c" using eq by auto
|
haftmann@26169
|
89 |
moreover from sumeq this have "b = d" by auto
|
haftmann@26169
|
90 |
ultimately show ?thesis by simp
|
haftmann@26169
|
91 |
next
|
haftmann@26169
|
92 |
assume "a + b \<ge> Suc (c + d)"
|
haftmann@26169
|
93 |
from sum_mono[OF this] eq
|
haftmann@26169
|
94 |
show ?thesis by auto
|
haftmann@26169
|
95 |
next
|
haftmann@26169
|
96 |
assume "c + d \<ge> Suc (a + b)"
|
haftmann@26169
|
97 |
from sum_mono[OF this] eq
|
haftmann@26169
|
98 |
show ?thesis by auto
|
haftmann@26169
|
99 |
qed
|
haftmann@26169
|
100 |
qed
|
haftmann@26169
|
101 |
|
haftmann@26169
|
102 |
instance "*" :: (countable, countable) countable
|
haftmann@26169
|
103 |
by (rule countable_classI [of "\<lambda>(x, y). pair_encode (to_nat x, to_nat y)"])
|
haftmann@26169
|
104 |
(auto dest: injD [OF inj_pair_cencode] injD [OF inj_to_nat])
|
haftmann@26169
|
105 |
|
haftmann@26169
|
106 |
|
haftmann@26169
|
107 |
text {* Sums *}
|
haftmann@26169
|
108 |
|
haftmann@26169
|
109 |
instance "+":: (countable, countable) countable
|
haftmann@26169
|
110 |
by (rule countable_classI [of "(\<lambda>x. case x of Inl a \<Rightarrow> to_nat (False, to_nat a)
|
haftmann@26169
|
111 |
| Inr b \<Rightarrow> to_nat (True, to_nat b))"])
|
haftmann@26169
|
112 |
(auto split:sum.splits)
|
haftmann@26169
|
113 |
|
haftmann@26169
|
114 |
|
haftmann@26169
|
115 |
text {* Integers *}
|
haftmann@26169
|
116 |
|
haftmann@26169
|
117 |
lemma int_cases: "(i::int) = 0 \<or> i < 0 \<or> i > 0"
|
haftmann@26169
|
118 |
by presburger
|
haftmann@26169
|
119 |
|
haftmann@26169
|
120 |
lemma int_pos_neg_zero:
|
haftmann@26169
|
121 |
obtains (zero) "(z::int) = 0" "sgn z = 0" "abs z = 0"
|
haftmann@26169
|
122 |
| (pos) n where "z = of_nat n" "sgn z = 1" "abs z = of_nat n"
|
haftmann@26169
|
123 |
| (neg) n where "z = - (of_nat n)" "sgn z = -1" "abs z = of_nat n"
|
krauss@26580
|
124 |
apply atomize_elim
|
haftmann@26169
|
125 |
apply (insert int_cases[of z])
|
haftmann@26169
|
126 |
apply (auto simp:zsgn_def)
|
haftmann@26169
|
127 |
apply (rule_tac x="nat (-z)" in exI, simp)
|
haftmann@26169
|
128 |
apply (rule_tac x="nat z" in exI, simp)
|
haftmann@26169
|
129 |
done
|
haftmann@26169
|
130 |
|
haftmann@26169
|
131 |
instance int :: countable
|
haftmann@26169
|
132 |
proof (rule countable_classI [of "(\<lambda>i. to_nat (nat (sgn i + 1), nat (abs i)))"],
|
haftmann@26169
|
133 |
auto dest: injD [OF inj_to_nat])
|
haftmann@26169
|
134 |
fix x y
|
haftmann@26169
|
135 |
assume a: "nat (sgn x + 1) = nat (sgn y + 1)" "nat (abs x) = nat (abs y)"
|
haftmann@26169
|
136 |
show "x = y"
|
haftmann@26169
|
137 |
proof (cases rule: int_pos_neg_zero[of x])
|
haftmann@26169
|
138 |
case zero
|
haftmann@26169
|
139 |
with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
|
haftmann@26169
|
140 |
next
|
haftmann@26169
|
141 |
case (pos n)
|
haftmann@26169
|
142 |
with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
|
haftmann@26169
|
143 |
next
|
haftmann@26169
|
144 |
case (neg n)
|
haftmann@26169
|
145 |
with a show "x = y" by (cases rule: int_pos_neg_zero[of y]) auto
|
haftmann@26169
|
146 |
qed
|
haftmann@26169
|
147 |
qed
|
haftmann@26169
|
148 |
|
haftmann@26169
|
149 |
|
haftmann@26169
|
150 |
text {* Options *}
|
haftmann@26169
|
151 |
|
haftmann@26169
|
152 |
instance option :: (countable) countable
|
haftmann@26169
|
153 |
by (rule countable_classI[of "\<lambda>x. case x of None \<Rightarrow> 0
|
haftmann@26169
|
154 |
| Some y \<Rightarrow> Suc (to_nat y)"])
|
haftmann@26169
|
155 |
(auto split:option.splits)
|
haftmann@26169
|
156 |
|
haftmann@26169
|
157 |
|
haftmann@26169
|
158 |
text {* Lists *}
|
haftmann@26169
|
159 |
|
haftmann@26169
|
160 |
lemma from_nat_to_nat_map [simp]: "map from_nat (map to_nat xs) = xs"
|
haftmann@26169
|
161 |
by (simp add: comp_def map_compose [symmetric])
|
haftmann@26169
|
162 |
|
haftmann@26169
|
163 |
primrec
|
haftmann@26169
|
164 |
list_encode :: "'a\<Colon>countable list \<Rightarrow> nat"
|
haftmann@26169
|
165 |
where
|
haftmann@26169
|
166 |
"list_encode [] = 0"
|
haftmann@26169
|
167 |
| "list_encode (x#xs) = Suc (to_nat (x, list_encode xs))"
|
haftmann@26169
|
168 |
|
haftmann@26169
|
169 |
instance list :: (countable) countable
|
haftmann@26169
|
170 |
proof (rule countable_classI [of "list_encode"])
|
haftmann@26169
|
171 |
fix xs ys :: "'a list"
|
haftmann@26169
|
172 |
assume cenc: "list_encode xs = list_encode ys"
|
haftmann@26169
|
173 |
then show "xs = ys"
|
haftmann@26169
|
174 |
proof (induct xs arbitrary: ys)
|
haftmann@26169
|
175 |
case (Nil ys)
|
haftmann@26169
|
176 |
with cenc show ?case by (cases ys, auto)
|
haftmann@26169
|
177 |
next
|
haftmann@26169
|
178 |
case (Cons x xs' ys)
|
haftmann@26169
|
179 |
thus ?case by (cases ys) auto
|
haftmann@26169
|
180 |
qed
|
haftmann@26169
|
181 |
qed
|
haftmann@26169
|
182 |
|
huffman@26243
|
183 |
|
huffman@26243
|
184 |
text {* Functions *}
|
huffman@26243
|
185 |
|
huffman@26243
|
186 |
instance "fun" :: (finite, countable) countable
|
huffman@26243
|
187 |
proof
|
huffman@26243
|
188 |
obtain xs :: "'a list" where xs: "set xs = UNIV"
|
huffman@26243
|
189 |
using finite_list [OF finite_UNIV] ..
|
huffman@26243
|
190 |
show "\<exists>to_nat::('a \<Rightarrow> 'b) \<Rightarrow> nat. inj to_nat"
|
huffman@26243
|
191 |
proof
|
huffman@26243
|
192 |
show "inj (\<lambda>f. to_nat (map f xs))"
|
huffman@26243
|
193 |
by (rule injI, simp add: xs expand_fun_eq)
|
huffman@26243
|
194 |
qed
|
huffman@26243
|
195 |
qed
|
huffman@26243
|
196 |
|
haftmann@26169
|
197 |
end
|