doc-src/TutorialI/Overview/RECDEF.thy
author berghofe
Thu, 13 Sep 2001 16:26:16 +0200
changeset 11563 e172cbed431d
parent 11293 6878bb02a7f9
child 12815 1f073030b97a
permissions -rw-r--r--
Fixed proof term bug in permute_prems.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
11235
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     1
theory RECDEF = Main:
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     2
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     3
subsection{*Wellfounded Recursion*}
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     4
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     5
subsubsection{*Examples*}
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     6
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     7
consts fib :: "nat \<Rightarrow> nat";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     8
recdef fib "measure(\<lambda>n. n)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
     9
  "fib 0 = 0"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    10
  "fib 1 = 1"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    11
  "fib (Suc(Suc x)) = fib x + fib (Suc x)";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    12
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    13
consts sep :: "'a \<times> 'a list \<Rightarrow> 'a list";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    14
recdef sep "measure (\<lambda>(a,xs). length xs)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    15
  "sep(a, [])     = []"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    16
  "sep(a, [x])    = [x]"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    17
  "sep(a, x#y#zs) = x # a # sep(a,y#zs)";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    18
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    19
consts last :: "'a list \<Rightarrow> 'a";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    20
recdef last "measure (\<lambda>xs. length xs)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    21
  "last [x]      = x"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    22
  "last (x#y#zs) = last (y#zs)";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    23
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    24
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    25
consts sep1 :: "'a \<times> 'a list \<Rightarrow> 'a list";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    26
recdef sep1 "measure (\<lambda>(a,xs). length xs)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    27
  "sep1(a, x#y#zs) = x # a # sep1(a,y#zs)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    28
  "sep1(a, xs)     = xs";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    29
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    30
thm sep1.simps
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    31
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    32
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    33
consts swap12 :: "'a list \<Rightarrow> 'a list";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    34
recdef swap12 "{}"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    35
  "swap12 (x#y#zs) = y#x#zs"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    36
  "swap12 zs       = zs";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    37
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    38
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    39
subsubsection{*Beyond Measure*}
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    40
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    41
consts ack :: "nat\<times>nat \<Rightarrow> nat";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    42
recdef ack "measure(\<lambda>m. m) <*lex*> measure(\<lambda>n. n)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    43
  "ack(0,n)         = Suc n"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    44
  "ack(Suc m,0)     = ack(m, 1)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    45
  "ack(Suc m,Suc n) = ack(m,ack(Suc m,n))";
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    46
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    47
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    48
subsubsection{*Induction*}
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    49
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    50
lemma "map f (sep(x,xs)) = sep(f x, map f xs)"
11293
6878bb02a7f9 *** empty log message ***
nipkow
parents: 11236
diff changeset
    51
thm sep.induct
11235
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    52
apply(induct_tac x xs rule: sep.induct)
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    53
apply simp_all
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    54
done
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    55
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    56
lemma ack_incr2: "n < ack(m,n)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    57
apply(induct_tac m n rule: ack.induct)
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    58
apply simp_all
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    59
done
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    60
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    61
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    62
subsubsection{*Recursion Over Nested Datatypes*}
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    63
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    64
datatype tree = C "tree list"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    65
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    66
lemma termi_lem: "t \<in> set ts \<longrightarrow> size t < Suc(tree_list_size ts)"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    67
by(induct_tac ts, auto)
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    68
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    69
consts mirror :: "tree \<Rightarrow> tree"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    70
recdef mirror "measure size"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    71
 "mirror(C ts) = C(rev(map mirror ts))"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    72
(hints recdef_simp: termi_lem)
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    73
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    74
lemma "mirror(mirror t) = t"
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    75
apply(induct_tac t rule: mirror.induct)
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    76
apply(simp add:rev_map sym[OF map_compose] cong:map_cong)
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    77
done
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    78
11236
17403c5a9eb1 *** empty log message ***
nipkow
parents: 11235
diff changeset
    79
text{*
17403c5a9eb1 *** empty log message ***
nipkow
parents: 11235
diff changeset
    80
\begin{exercise}
17403c5a9eb1 *** empty log message ***
nipkow
parents: 11235
diff changeset
    81
Define a function for merging two ordered lists (of natural numbers) and
17403c5a9eb1 *** empty log message ***
nipkow
parents: 11235
diff changeset
    82
show that if the two input lists are ordered, so is the output.
17403c5a9eb1 *** empty log message ***
nipkow
parents: 11235
diff changeset
    83
\end{exercise}
17403c5a9eb1 *** empty log message ***
nipkow
parents: 11235
diff changeset
    84
*}
17403c5a9eb1 *** empty log message ***
nipkow
parents: 11235
diff changeset
    85
11235
860c65c7388a *** empty log message ***
nipkow
parents:
diff changeset
    86
end