doc-src/TutorialI/Overview/LNCS/RECDEF.thy
author huffman
Mon, 08 Mar 2010 11:34:53 -0800
changeset 35655 e8e4af6da819
parent 16417 9bc16273c2d4
permissions -rw-r--r--
generate take_induct lemmas
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13262
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     1
(*<*)
16417
9bc16273c2d4 migrated theory headers to new format
haftmann
parents: 15905
diff changeset
     2
theory RECDEF imports Main begin
13262
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     3
(*>*)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     4
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     5
subsection{*Wellfounded Recursion*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     6
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     7
subsubsection{*Examples*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     8
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     9
consts fib :: "nat \<Rightarrow> nat";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    10
recdef fib "measure(\<lambda>n. n)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    11
  "fib 0 = 0"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    12
  "fib (Suc 0) = 1"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    13
  "fib (Suc(Suc x)) = fib x + fib (Suc x)";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    14
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    15
consts sep :: "'a \<times> 'a list \<Rightarrow> 'a list";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    16
recdef sep "measure (\<lambda>(a,xs). length xs)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    17
  "sep(a, [])     = []"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    18
  "sep(a, [x])    = [x]"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    19
  "sep(a, x#y#zs) = x # a # sep(a,y#zs)";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    20
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    21
consts last :: "'a list \<Rightarrow> 'a";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    22
recdef last "measure (\<lambda>xs. length xs)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    23
  "last [x]      = x"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    24
  "last (x#y#zs) = last (y#zs)";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    25
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    26
consts sep1 :: "'a \<times> 'a list \<Rightarrow> 'a list";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    27
recdef sep1 "measure (\<lambda>(a,xs). length xs)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    28
  "sep1(a, x#y#zs) = x # a # sep1(a,y#zs)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    29
  "sep1(a, xs)     = xs";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    30
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    31
text{*
15905
0a4cc9b113c7 introduced @{const ...} antiquotation
haftmann
parents: 13262
diff changeset
    32
This is what the rules for @{const sep1} are turned into:
13262
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    33
@{thm[display,indent=5] sep1.simps[no_vars]}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    34
*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    35
(*<*)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    36
thm sep1.simps
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    37
(*>*)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    38
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    39
text{*
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    40
Pattern matching is also useful for nonrecursive functions:
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    41
*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    42
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    43
consts swap12 :: "'a list \<Rightarrow> 'a list";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    44
recdef swap12 "{}"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    45
  "swap12 (x#y#zs) = y#x#zs"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    46
  "swap12 zs       = zs";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    47
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    48
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    49
subsubsection{*Beyond Measure*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    50
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    51
text{*
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    52
The lexicographic product of two relations:
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    53
*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    54
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    55
consts ack :: "nat\<times>nat \<Rightarrow> nat";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    56
recdef ack "measure(\<lambda>m. m) <*lex*> measure(\<lambda>n. n)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    57
  "ack(0,n)         = Suc n"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    58
  "ack(Suc m,0)     = ack(m, 1)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    59
  "ack(Suc m,Suc n) = ack(m,ack(Suc m,n))";
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    60
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    61
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    62
subsubsection{*Induction*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    63
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    64
text{*
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    65
Every recursive definition provides an induction theorem, for example
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    66
@{thm[source]sep.induct}:
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    67
@{thm[display,margin=70] sep.induct[no_vars]}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    68
*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    69
(*<*)thm sep.induct[no_vars](*>*)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    70
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    71
lemma "map f (sep(x,xs)) = sep(f x, map f xs)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    72
apply(induct_tac x xs rule: sep.induct)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    73
apply simp_all
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    74
done
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    75
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    76
lemma ack_incr2: "n < ack(m,n)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    77
apply(induct_tac m n rule: ack.induct)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    78
apply simp_all
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    79
done
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    80
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    81
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    82
subsubsection{*Recursion Over Nested Datatypes*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    83
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    84
datatype tree = C "tree list"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    85
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    86
lemma termi_lem: "t \<in> set ts \<longrightarrow> size t < Suc(tree_list_size ts)"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    87
by(induct_tac ts, auto)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    88
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    89
consts mirror :: "tree \<Rightarrow> tree"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    90
recdef mirror "measure size"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    91
 "mirror(C ts) = C(rev(map mirror ts))"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    92
(hints recdef_simp: termi_lem)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    93
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    94
lemma "mirror(mirror t) = t"
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    95
apply(induct_tac t rule: mirror.induct)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    96
apply(simp add: rev_map sym[OF map_compose] cong: map_cong)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    97
done
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    98
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    99
text{*
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   100
Figure out how that proof worked!
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   101
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   102
\begin{exercise}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   103
Define a function for merging two ordered lists (of natural numbers) and
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   104
show that if the two input lists are ordered, so is the output.
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   105
\end{exercise}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   106
*}
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   107
(*<*)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   108
end
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
   109
(*>*)