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