src/HOL/Induct/Tree.thy
author haftmann
Wed Jun 10 15:04:31 2009 +0200 (2009-06-10)
changeset 31602 59df8222c204
parent 21404 eb85850d3eb7
child 35419 d78659d1723e
permissions -rw-r--r--
tuned header
berghofe@7018
     1
(*  Title:      HOL/Induct/Tree.thy
berghofe@7018
     2
    Author:     Stefan Berghofer,  TU Muenchen
paulson@16078
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
berghofe@7018
     4
*)
berghofe@7018
     5
wenzelm@11046
     6
header {* Infinitely branching trees *}
wenzelm@11046
     7
haftmann@31602
     8
theory Tree
haftmann@31602
     9
imports Main
haftmann@31602
    10
begin
berghofe@7018
    11
wenzelm@11046
    12
datatype 'a tree =
wenzelm@11046
    13
    Atom 'a
wenzelm@11046
    14
  | Branch "nat => 'a tree"
berghofe@7018
    15
berghofe@7018
    16
consts
berghofe@7018
    17
  map_tree :: "('a => 'b) => 'a tree => 'b tree"
berghofe@7018
    18
primrec
berghofe@7018
    19
  "map_tree f (Atom a) = Atom (f a)"
wenzelm@11046
    20
  "map_tree f (Branch ts) = Branch (\<lambda>x. map_tree f (ts x))"
wenzelm@11046
    21
wenzelm@11046
    22
lemma tree_map_compose: "map_tree g (map_tree f t) = map_tree (g \<circ> f) t"
wenzelm@12171
    23
  by (induct t) simp_all
berghofe@7018
    24
berghofe@7018
    25
consts
berghofe@7018
    26
  exists_tree :: "('a => bool) => 'a tree => bool"
berghofe@7018
    27
primrec
berghofe@7018
    28
  "exists_tree P (Atom a) = P a"
wenzelm@11046
    29
  "exists_tree P (Branch ts) = (\<exists>x. exists_tree P (ts x))"
wenzelm@11046
    30
wenzelm@11046
    31
lemma exists_map:
wenzelm@11046
    32
  "(!!x. P x ==> Q (f x)) ==>
wenzelm@11046
    33
    exists_tree P ts ==> exists_tree Q (map_tree f ts)"
wenzelm@12171
    34
  by (induct ts) auto
berghofe@7018
    35
paulson@16078
    36
paulson@16078
    37
subsection{*The Brouwer ordinals, as in ZF/Induct/Brouwer.thy.*}
paulson@16078
    38
paulson@16078
    39
datatype brouwer = Zero | Succ "brouwer" | Lim "nat => brouwer"
paulson@16078
    40
paulson@16078
    41
text{*Addition of ordinals*}
paulson@16078
    42
consts
paulson@16078
    43
  add :: "[brouwer,brouwer] => brouwer"
paulson@16078
    44
primrec
paulson@16078
    45
  "add i Zero = i"
paulson@16078
    46
  "add i (Succ j) = Succ (add i j)"
paulson@16078
    47
  "add i (Lim f) = Lim (%n. add i (f n))"
paulson@16078
    48
paulson@16078
    49
lemma add_assoc: "add (add i j) k = add i (add j k)"
wenzelm@18242
    50
  by (induct k) auto
paulson@16078
    51
paulson@16078
    52
text{*Multiplication of ordinals*}
paulson@16078
    53
consts
paulson@16078
    54
  mult :: "[brouwer,brouwer] => brouwer"
paulson@16078
    55
primrec
paulson@16078
    56
  "mult i Zero = Zero"
paulson@16078
    57
  "mult i (Succ j) = add (mult i j) i"
paulson@16078
    58
  "mult i (Lim f) = Lim (%n. mult i (f n))"
paulson@16078
    59
paulson@16078
    60
lemma add_mult_distrib: "mult i (add j k) = add (mult i j) (mult i k)"
wenzelm@18242
    61
  by (induct k) (auto simp add: add_assoc)
paulson@16078
    62
paulson@16078
    63
lemma mult_assoc: "mult (mult i j) k = mult i (mult j k)"
wenzelm@18242
    64
  by (induct k) (auto simp add: add_mult_distrib)
paulson@16078
    65
paulson@16078
    66
text{*We could probably instantiate some axiomatic type classes and use
paulson@16078
    67
the standard infix operators.*}
paulson@16078
    68
paulson@16174
    69
subsection{*A WF Ordering for The Brouwer ordinals (Michael Compton)*}
paulson@16174
    70
paulson@16174
    71
text{*To define recdef style functions we need an ordering on the Brouwer
paulson@16174
    72
  ordinals.  Start with a predecessor relation and form its transitive 
paulson@16174
    73
  closure. *} 
paulson@16174
    74
wenzelm@19736
    75
definition
wenzelm@21404
    76
  brouwer_pred :: "(brouwer * brouwer) set" where
wenzelm@19736
    77
  "brouwer_pred = (\<Union>i. {(m,n). n = Succ m \<or> (EX f. n = Lim f & m = f i)})"
paulson@16174
    78
wenzelm@21404
    79
definition
wenzelm@21404
    80
  brouwer_order :: "(brouwer * brouwer) set" where
wenzelm@19736
    81
  "brouwer_order = brouwer_pred^+"
paulson@16174
    82
paulson@16174
    83
lemma wf_brouwer_pred: "wf brouwer_pred"
paulson@16174
    84
  by(unfold wf_def brouwer_pred_def, clarify, induct_tac x, blast+)
paulson@16174
    85
paulson@16174
    86
lemma wf_brouwer_order: "wf brouwer_order"
paulson@16174
    87
  by(unfold brouwer_order_def, rule wf_trancl[OF wf_brouwer_pred])
paulson@16174
    88
paulson@16174
    89
lemma [simp]: "(j, Succ j) : brouwer_order"
paulson@16174
    90
  by(auto simp add: brouwer_order_def brouwer_pred_def)
paulson@16174
    91
paulson@16174
    92
lemma [simp]: "(f n, Lim f) : brouwer_order"
paulson@16174
    93
  by(auto simp add: brouwer_order_def brouwer_pred_def)
paulson@16174
    94
paulson@16174
    95
text{*Example of a recdef*}
paulson@16174
    96
consts
paulson@16174
    97
  add2 :: "(brouwer*brouwer) => brouwer"
paulson@16174
    98
recdef add2 "inv_image brouwer_order (\<lambda> (x,y). y)"
paulson@16174
    99
  "add2 (i, Zero) = i"
paulson@16174
   100
  "add2 (i, (Succ j)) = Succ (add2 (i, j))"
paulson@16174
   101
  "add2 (i, (Lim f)) = Lim (\<lambda> n. add2 (i, (f n)))"
paulson@16174
   102
  (hints recdef_wf: wf_brouwer_order)
paulson@16174
   103
paulson@16174
   104
lemma add2_assoc: "add2 (add2 (i, j), k) = add2 (i, add2 (j, k))"
wenzelm@18242
   105
  by (induct k) auto
paulson@16174
   106
berghofe@7018
   107
end