doc-src/TutorialI/Overview/LNCS/RECDEF.thy
author chaieb
Wed, 19 May 2004 11:23:59 +0200
changeset 14758 af3b71a46a1c
parent 13262 bbfc360db011
child 15905 0a4cc9b113c7
permissions -rw-r--r--
A new implementation for presburger arithmetic following the one suggested in technical report Chaieb Amine and Tobias Nipkow. It is generic an smaller. the tactic has also changed and allows the abstaction over fuction occurences whose type is nat or int.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13262
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     1
(*<*)
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
     2
theory RECDEF = Main:
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{*
bbfc360db011 *** empty log message ***
nipkow
parents:
diff changeset
    32
This is what the rules for @{term sep1} are turned into:
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
(*>*)