src/HOL/Library/Countable.thy
author huffman
Thu, 23 Jun 2011 10:07:16 -0700
changeset 43534 15df7bc8e93f
parent 40702 cf26dd7395e4
child 43992 c38c65a1bf9c
permissions -rw-r--r--
add countable_datatype method for proving countable class instances
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
43534
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
     3
    Author:     Brian Huffman, Portland State University
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
     4
*)
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
     5
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
     6
header {* Encoding (almost) everything into natural numbers *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
     7
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
     8
theory Countable
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
     9
imports Main Rat Nat_Bijection
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    10
begin
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    11
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    12
subsection {* The class of countable types *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    13
29797
08ef36ed2f8a handling type classes without parameters
haftmann
parents: 29511
diff changeset
    14
class countable =
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    15
  assumes ex_inj: "\<exists>to_nat \<Colon> 'a \<Rightarrow> nat. inj to_nat"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    16
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    17
lemma countable_classI:
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    18
  fixes f :: "'a \<Rightarrow> nat"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    19
  assumes "\<And>x y. f x = f y \<Longrightarrow> x = y"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    20
  shows "OFCLASS('a, countable_class)"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    21
proof (intro_classes, rule exI)
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    22
  show "inj f"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    23
    by (rule injI [OF assms]) assumption
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    24
qed
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    25
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    26
26585
3bf2ebb7148e fix spelling
huffman
parents: 26580
diff changeset
    27
subsection {* Conversion functions *}
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    28
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    29
definition to_nat :: "'a\<Colon>countable \<Rightarrow> nat" where
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    30
  "to_nat = (SOME f. inj f)"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    31
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    32
definition from_nat :: "nat \<Rightarrow> 'a\<Colon>countable" where
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    33
  "from_nat = inv (to_nat \<Colon> 'a \<Rightarrow> nat)"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    34
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    35
lemma inj_to_nat [simp]: "inj to_nat"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    36
  by (rule exE_some [OF ex_inj]) (simp add: to_nat_def)
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    37
29910
623c9c20966b add lemma surj_from_nat
huffman
parents: 29880
diff changeset
    38
lemma surj_from_nat [simp]: "surj from_nat"
623c9c20966b add lemma surj_from_nat
huffman
parents: 29880
diff changeset
    39
  unfolding from_nat_def by (simp add: inj_imp_surj_inv)
623c9c20966b add lemma surj_from_nat
huffman
parents: 29880
diff changeset
    40
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    41
lemma to_nat_split [simp]: "to_nat x = to_nat y \<longleftrightarrow> x = y"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    42
  using injD [OF inj_to_nat] by auto
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    43
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    44
lemma from_nat_to_nat [simp]:
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    45
  "from_nat (to_nat x) = x"
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    46
  by (simp add: from_nat_def)
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    47
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    48
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    49
subsection {* Countable types *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    50
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    51
instance nat :: countable
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    52
  by (rule countable_classI [of "id"]) simp
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    53
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    54
subclass (in finite) countable
28823
dcbef866c9e2 tuned unfold_locales invocation
haftmann
parents: 27487
diff changeset
    55
proof
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    56
  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
    57
  with finite_conv_nat_seg_image [of "UNIV::'a set"]
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    58
  obtain n and f :: "nat \<Rightarrow> 'a" 
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    59
    where "UNIV = f ` {i. i < n}" by auto
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    60
  then have "surj f" unfolding surj_def by auto
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    61
  then have "inj (inv f)" by (rule surj_imp_inj_inv)
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    62
  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
    63
qed
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    64
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    65
text {* Pairs *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    66
37678
0040bafffdef "prod" and "sum" replace "*" and "+" respectively
haftmann
parents: 37652
diff changeset
    67
instance prod :: (countable, countable) countable
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    68
  by (rule countable_classI [of "\<lambda>(x, y). prod_encode (to_nat x, to_nat y)"])
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    69
    (auto simp add: prod_encode_eq)
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    70
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    71
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    72
text {* Sums *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    73
37678
0040bafffdef "prod" and "sum" replace "*" and "+" respectively
haftmann
parents: 37652
diff changeset
    74
instance sum :: (countable, countable) countable
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    75
  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
    76
                                     | Inr b \<Rightarrow> to_nat (True, to_nat b))"])
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    77
    (simp split: sum.split_asm)
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    78
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    79
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    80
text {* Integers *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    81
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    82
instance int :: countable
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    83
  by (rule countable_classI [of "int_encode"])
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    84
    (simp add: int_encode_eq)
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    85
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    86
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    87
text {* Options *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    88
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    89
instance option :: (countable) countable
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    90
  by (rule countable_classI [of "option_case 0 (Suc \<circ> to_nat)"])
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    91
    (simp split: option.split_asm)
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    92
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    93
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    94
text {* Lists *}
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    95
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    96
instance list :: (countable) countable
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    97
  by (rule countable_classI [of "list_encode \<circ> map to_nat"])
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
    98
    (simp add: list_encode_eq)
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
    99
26243
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   100
37652
6aa09d2a6cf9 added literal and typerep instances
haftmann
parents: 37388
diff changeset
   101
text {* Further *}
6aa09d2a6cf9 added literal and typerep instances
haftmann
parents: 37388
diff changeset
   102
6aa09d2a6cf9 added literal and typerep instances
haftmann
parents: 37388
diff changeset
   103
instance String.literal :: countable
39250
548a3e5521ab changing String.literal to a type instead of a datatype
bulwahn
parents: 39198
diff changeset
   104
  by (rule countable_classI [of "to_nat o explode"])
548a3e5521ab changing String.literal to a type instead of a datatype
bulwahn
parents: 39198
diff changeset
   105
    (auto simp add: explode_inject)
37652
6aa09d2a6cf9 added literal and typerep instances
haftmann
parents: 37388
diff changeset
   106
26243
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   107
text {* Functions *}
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   108
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   109
instance "fun" :: (finite, countable) countable
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   110
proof
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   111
  obtain xs :: "'a list" where xs: "set xs = UNIV"
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   112
    using finite_list [OF finite_UNIV] ..
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   113
  show "\<exists>to_nat::('a \<Rightarrow> 'b) \<Rightarrow> nat. inj to_nat"
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   114
  proof
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   115
    show "inj (\<lambda>f. to_nat (map f xs))"
39302
d7728f65b353 renamed lemmas: ext_iff -> fun_eq_iff, set_ext_iff -> set_eq_iff, set_ext -> set_eqI
nipkow
parents: 39250
diff changeset
   116
      by (rule injI, simp add: xs fun_eq_iff)
26243
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   117
  qed
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   118
qed
69592314f977 instance fun :: (finite, countable) countable
huffman
parents: 26169
diff changeset
   119
29880
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   120
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   121
subsection {* The Rationals are Countably Infinite *}
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   122
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   123
definition nat_to_rat_surj :: "nat \<Rightarrow> rat" where
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
   124
"nat_to_rat_surj n = (let (a,b) = prod_decode n
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
   125
                      in Fract (int_decode a) (int_decode b))"
29880
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   126
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   127
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
   128
unfolding surj_def
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   129
proof
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   130
  fix r::rat
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   131
  show "\<exists>n. r = nat_to_rat_surj n"
35374
af1c8c15340e adjusted to cs. e4a7947e02b8
haftmann
parents: 33640
diff changeset
   132
  proof (cases r)
af1c8c15340e adjusted to cs. e4a7947e02b8
haftmann
parents: 33640
diff changeset
   133
    fix i j assume [simp]: "r = Fract i j" and "j > 0"
35700
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
   134
    have "r = (let m = int_encode i; n = int_encode j
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
   135
               in nat_to_rat_surj(prod_encode (m,n)))"
951974ce903e new theory Library/Nat_Bijection.thy
huffman
parents: 35374
diff changeset
   136
      by (simp add: Let_def nat_to_rat_surj_def)
29880
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   137
    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
   138
  qed
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   139
qed
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   140
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   141
lemma Rats_eq_range_nat_to_rat_surj: "\<rat> = range nat_to_rat_surj"
40702
cf26dd7395e4 Replace surj by abbreviation; remove surj_on.
hoelzl
parents: 39302
diff changeset
   142
by (simp add: Rats_def surj_nat_to_rat_surj)
29880
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   143
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   144
context field_char_0
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   145
begin
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   146
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   147
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
   148
  "\<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
   149
using surj_nat_to_rat_surj
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   150
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
   151
   (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
   152
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   153
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
   154
  "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
   155
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
   156
26169
73027318f9ba added theory for countable types
haftmann
parents:
diff changeset
   157
end
29880
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   158
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   159
instance rat :: countable
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   160
proof
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   161
  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
   162
  proof
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   163
    have "surj nat_to_rat_surj"
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   164
      by (rule surj_nat_to_rat_surj)
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   165
    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
   166
      by (rule surj_imp_inj_inv)
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   167
  qed
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   168
qed
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   169
43534
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   170
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   171
subsection {* Automatically proving countability of datatypes *}
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   172
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   173
inductive finite_item :: "'a Datatype.item \<Rightarrow> bool" where
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   174
  undefined: "finite_item undefined"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   175
| In0: "finite_item x \<Longrightarrow> finite_item (Datatype.In0 x)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   176
| In1: "finite_item x \<Longrightarrow> finite_item (Datatype.In1 x)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   177
| Leaf: "finite_item (Datatype.Leaf a)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   178
| Scons: "\<lbrakk>finite_item x; finite_item y\<rbrakk> \<Longrightarrow> finite_item (Datatype.Scons x y)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   179
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   180
function
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   181
  nth_item :: "nat \<Rightarrow> ('a::countable) Datatype.item"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   182
where
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   183
  "nth_item 0 = undefined"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   184
| "nth_item (Suc n) =
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   185
  (case sum_decode n of
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   186
    Inl i \<Rightarrow>
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   187
    (case sum_decode i of
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   188
      Inl j \<Rightarrow> Datatype.In0 (nth_item j)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   189
    | Inr j \<Rightarrow> Datatype.In1 (nth_item j))
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   190
  | Inr i \<Rightarrow>
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   191
    (case sum_decode i of
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   192
      Inl j \<Rightarrow> Datatype.Leaf (from_nat j)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   193
    | Inr j \<Rightarrow>
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   194
      (case prod_decode j of
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   195
        (a, b) \<Rightarrow> Datatype.Scons (nth_item a) (nth_item b))))"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   196
by pat_completeness auto
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   197
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   198
lemma le_sum_encode_Inl: "x \<le> y \<Longrightarrow> x \<le> sum_encode (Inl y)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   199
unfolding sum_encode_def by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   200
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   201
lemma le_sum_encode_Inr: "x \<le> y \<Longrightarrow> x \<le> sum_encode (Inr y)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   202
unfolding sum_encode_def by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   203
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   204
termination
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   205
by (relation "measure id")
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   206
  (auto simp add: sum_encode_eq [symmetric] prod_encode_eq [symmetric]
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   207
    le_imp_less_Suc le_sum_encode_Inl le_sum_encode_Inr
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   208
    le_prod_encode_1 le_prod_encode_2)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   209
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   210
lemma nth_item_covers: "finite_item x \<Longrightarrow> \<exists>n. nth_item n = x"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   211
proof (induct set: finite_item)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   212
  case undefined
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   213
  have "nth_item 0 = undefined" by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   214
  thus ?case ..
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   215
next
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   216
  case (In0 x)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   217
  then obtain n where "nth_item n = x" by fast
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   218
  hence "nth_item (Suc (sum_encode (Inl (sum_encode (Inl n)))))
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   219
    = Datatype.In0 x" by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   220
  thus ?case ..
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   221
next
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   222
  case (In1 x)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   223
  then obtain n where "nth_item n = x" by fast
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   224
  hence "nth_item (Suc (sum_encode (Inl (sum_encode (Inr n)))))
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   225
    = Datatype.In1 x" by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   226
  thus ?case ..
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   227
next
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   228
  case (Leaf a)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   229
  have "nth_item (Suc (sum_encode (Inr (sum_encode (Inl (to_nat a))))))
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   230
    = Datatype.Leaf a" by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   231
  thus ?case ..
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   232
next
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   233
  case (Scons x y)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   234
  then obtain i j where "nth_item i = x" and "nth_item j = y" by fast
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   235
  hence "nth_item
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   236
    (Suc (sum_encode (Inr (sum_encode (Inr (prod_encode (i, j)))))))
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   237
      = Datatype.Scons x y" by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   238
  thus ?case ..
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   239
qed
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   240
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   241
theorem countable_datatype:
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   242
  fixes Rep :: "'b \<Rightarrow> ('a::countable) Datatype.item"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   243
  fixes Abs :: "('a::countable) Datatype.item \<Rightarrow> 'b"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   244
  fixes rep_set :: "('a::countable) Datatype.item \<Rightarrow> bool"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   245
  assumes type: "type_definition Rep Abs (Collect rep_set)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   246
  assumes finite_item: "\<And>x. rep_set x \<Longrightarrow> finite_item x"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   247
  shows "OFCLASS('b, countable_class)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   248
proof
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   249
  def f \<equiv> "\<lambda>y. LEAST n. nth_item n = Rep y"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   250
  {
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   251
    fix y :: 'b
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   252
    have "rep_set (Rep y)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   253
      using type_definition.Rep [OF type] by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   254
    hence "finite_item (Rep y)"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   255
      by (rule finite_item)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   256
    hence "\<exists>n. nth_item n = Rep y"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   257
      by (rule nth_item_covers)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   258
    hence "nth_item (f y) = Rep y"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   259
      unfolding f_def by (rule LeastI_ex)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   260
    hence "Abs (nth_item (f y)) = y"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   261
      using type_definition.Rep_inverse [OF type] by simp
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   262
  }
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   263
  hence "inj f"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   264
    by (rule inj_on_inverseI)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   265
  thus "\<exists>f::'b \<Rightarrow> nat. inj f"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   266
    by - (rule exI)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   267
qed
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   268
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   269
method_setup countable_datatype = {*
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   270
let
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   271
  fun countable_tac ctxt =
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   272
    SUBGOAL (fn (goal, i) =>
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   273
      let
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   274
        val ty_name =
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   275
          (case goal of
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   276
            (_ $ Const ("TYPE", Type ("itself", [Type (n, _)]))) => n
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   277
          | _ => raise Match)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   278
        val typedef_info = hd (Typedef.get_info ctxt ty_name)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   279
        val typedef_thm = #type_definition (snd typedef_info)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   280
        val pred_name =
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   281
          (case HOLogic.dest_Trueprop (concl_of typedef_thm) of
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   282
            (typedef $ rep $ abs $ (collect $ Const (n, _))) => n
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   283
          | _ => raise Match)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   284
        val induct_info = Inductive.the_inductive ctxt pred_name
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   285
        val pred_names = #names (fst induct_info)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   286
        val induct_thms = #inducts (snd induct_info)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   287
        val alist = pred_names ~~ induct_thms
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   288
        val induct_thm = the (AList.lookup (op =) alist pred_name)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   289
        val rules = @{thms finite_item.intros}
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   290
      in
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   291
        SOLVED' (fn i => EVERY
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   292
          [rtac @{thm countable_datatype} i,
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   293
           rtac typedef_thm i,
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   294
           etac induct_thm i,
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   295
           REPEAT (resolve_tac rules i ORELSE atac i)]) 1
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   296
      end)
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   297
in
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   298
  Scan.succeed (fn ctxt => SIMPLE_METHOD' (countable_tac ctxt))
29880
3dee8ff45d3d move countability proof from Rational to Countable; add instance rat :: countable
huffman
parents: 29797
diff changeset
   299
end
43534
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   300
*} "prove countable class instances for datatypes"
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   301
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   302
hide_const (open) finite_item nth_item
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   303
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   304
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   305
subsection {* Countable datatypes *}
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   306
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   307
instance typerep :: countable
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   308
  by countable_datatype
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   309
15df7bc8e93f add countable_datatype method for proving countable class instances
huffman
parents: 40702
diff changeset
   310
end