theory Recursive_Functions
imports Main
begin
section\Recursive datatypes and functions\
(*some familiar type constructors*)
term "None"
term "Some x"
term "case x of None \ g | Some y \ f y"
term "Inl x"
term "Inr x"
term "case x of Inl x \ f x | Inr x \ g x"
(*the unit constant*)
term "()"
(*pairs*)
term "(x, y)"
term "fst (x, y)"
value "snd (x, y)"
subsection\Lists\
(*lists are already implemented as part of the Isabelle library...*)
term "[]"
term "[1,2,3]"
datatype 'a seq
= Empty ("\") (*some syntactic sugar*)
| Cons 'a "'a seq" (infixr "\" 65) (*declaring \ to be right-infix sugar for Cons*)
(*definitions are restricted to non-recursive functions*)
definition singleton :: "'a \ 'a seq" ("\_\" [65]65) where
"singleton x \ x \ \" (* note definitions do not support top-level pattern matching*)
(*each definition has an accompanying defining theorem*)
thm singleton_def (*name is name of defined constant with "_def" appended*)
(*some hopefully familiar recursive functions*)
fun map :: "('a \ 'b) \ 'a seq \ 'b seq" where
"map f \ = \" |
"map f (x \ xs) = f x \ map f xs"
fun app :: "'a seq \ 'a seq \ 'a seq" where
"app \ ys = ys" |
"app (x \ xs) ys = x \ (app xs ys)"
fun fold_right :: "('a \ 'b \ 'b) \ 'a seq \ 'b \ 'b" where
"fold_right f \ e = e" |
"fold_right f (x \ xs) e = f x (fold_right f xs e)"
(*note in all cases, Isabelle spots that the functions are terminating automatically*)
(*another definition!*)
definition flatten :: "'a seq seq \ 'a seq" where
"flatten xss \ fold_right app xss \"
thm flatten_def
fun len :: "'a seq \ nat" where
"len \ = 0" |
"len (x \ xs) = 1 + len xs"
(*recursive functions give rise to inductive proofs*)
(*properties about these simple recursive functions*)
lemma
shows "len (app xs ys) = len xs + len ys"
apply(induction xs)
apply simp
apply simp
done
lemma len_app [simp]:
shows "len (app xs ys) = len xs + len ys"
by(induction xs, auto)
lemma len_map [simp]:
shows "len (map f xs) = len xs"
by(induction xs, auto)
lemma map_id_ext:
assumes "\x. f x = x"
shows "map f xs = xs"
by(induction xs, auto simp add: assms)
(*corollary, lemma, and theorem keywords all have the same meaning (to Isabelle, at least)*)
corollary map_id [simp]:
shows "map id xs = xs" (*"id" is the identity function*)
apply(rule map_id_ext)
apply simp
done
lemma map_comp [simp]:
shows "map f (map g xs) = map (f o g) xs" (*"f o g" is function composition*)
apply(induction xs)
apply simp
apply simp
done
(*note: Isabelle does not unfold definitions automatically when simplifying, defining theorems must
be manually unfolded or added to the simpset when proving theorems about definitions*)
lemma flatten_Nil:
shows "flatten \ = \"
apply(simp add: flatten_def)
done
lemma flatten_Cons:
shows "flatten (x \ xss) = app x (flatten xss)"
by(simp add: flatten_def)
lemma app_assoc:
shows "app xs (app ys zs) = app (app xs ys) zs"
by(induction xs, auto)
(*remove the three lemmas above to appreciate what the simplifier is doing below*)
lemma flatten_app [simp]:
shows "flatten (app xss yss) = app (flatten xss) (flatten yss)"
apply(induction xss)
apply(auto simp add: flatten_Nil flatten_Cons app_assoc)
done
subsection\Binary trees\
(*slightly more complex examples*)
datatype 'a tree
= Leaf
| Branch "'a tree" "'a" "'a tree"
term "Branch"
fun mem :: "'a \ 'a tree \ bool" where
"mem x Leaf = False" |
"mem x (Branch l e r) =
(if x = e then
True
else if mem x l then
True
else mem x r)"
fun mirror :: "'a tree \ 'a tree" where
"mirror Leaf = Leaf" |
"mirror (Branch l e r) = Branch (mirror r) e (mirror l)"
fun as_seq :: "'a tree \ 'a seq" where
"as_seq Leaf = \" |
"as_seq (Branch l e r) = app (as_seq l) (app (\ e \) (as_seq r))"
fun sz :: "'a tree \ nat" where
"sz Leaf = 0" |
"sz (Branch l e r) = 1 + sz l + sz r"
lemma mem_mirror [intro]: (*[intro] attribute used to mark introduction rules for automation*)
assumes "mem x t"
shows "mem x (mirror t)"
using assms
apply(induction t)
apply(simp only: mem.simps)
apply(simp split!: if_split_asm) (*split!: aggressively use the if_split_asm theorem to split the if*)
done
thm if_split_asm (*for splitting if in assumptions*)
thm if_split (*for splitting if in conclusions*)
lemma mirror_invol [simp]:
shows "mirror (mirror t) = t"
by(induction t, auto)
lemma sz_len [simp]:
shows "len (as_seq t) = sz t"
apply(induction t)
apply(auto simp add: singleton_def)
done
lemma
shows "sz (mirror t) = sz t"
apply(induction t)
apply auto
done
subsection\Mutually recursive types\
(*separate the types using the "and" keyword*)
datatype 'a three_tree
= Leaf "'a"
| Split3 "'a two_tree" "'a two_tree" "'a two_tree"
and 'a two_tree
= Split2 "'a three_tree" "'a three_tree"
datatype way = L | C | R
(*mutually recursive types require mutually recursive functions*)
(*define the two functions together using the "and" keyword*)
fun navigate :: "way list \ 'a three_tree \ 'a option"
and navigate' :: "way list \ 'a two_tree \ 'a option" where
"navigate [] (Leaf l) = Some l" |
"navigate (w#ws) (Split3 l c r) =
(case w of L \ navigate' ws l | C \ navigate' ws c | R \ navigate' ws r)" |
"navigate _ _ = None" |
"navigate' (w#ws) (Split2 l r) =
(case w of L \ navigate ws l | R \ navigate ws r | C \ None)" |
"navigate' _ _ = None"
thm navigate_navigate'.induct
thm navigate.simps
thm navigate'.simps
fun depth :: "'a three_tree \ nat"
and depth' :: "'a two_tree \ nat" where
"depth (Leaf l) = 0" |
"depth (Split3 l c r) =
1 + max (depth' l) (max (depth' c) (depth' r))" |
"depth' (Split2 l r) = 1 + max (depth l) (depth r)"
thm three_tree_two_tree.induct
lemma
fixes t :: "'a three_tree" and u :: "'a two_tree"
shows "(navigate xs t = Some e \ length xs \ depth t) \
(navigate' ys u = Some f \ length ys \ depth' u)"
apply(induction rule: three_tree_two_tree.induct)
oops (*IH not usable...*)
(*generalise statement to get nicer IHs*)
lemma navigate_Some_length:
fixes t :: "'a three_tree" and u :: "'a two_tree"
shows "(\xs e. navigate xs t = Some e \ length xs \ depth t) \
(\ys f. navigate' ys u = Some f \ length ys \ depth' u)"
apply(induction rule: three_tree_two_tree.induct)
apply(clarsimp)
apply(case_tac xs; simp)
apply clarsimp
apply(case_tac xs; simp split!: way.split_asm)
apply force
apply force
apply force
apply clarsimp
apply(case_tac ys; simp split!: way.split_asm)
apply force+
done
thm navigate_Some_length
(*more usable form*)
lemma navigate_Some_length':
shows "navigate xs t = Some e \ length xs \ depth t"
and "navigate' ys u = Some f \ length ys \ depth' u"
using navigate_Some_length by force+
thm navigate_Some_length'(1)
thm navigate_Some_length'(2)
(*nicer way of doing this generalisation later...*)
subsection\Special and custom induction principles\
fun merge :: "int list \ int list \ int list" where
"merge [] ys = ys" |
"merge xs [] = xs" |
"merge (x#xs) (y#ys) =
(if x < y then
x#merge xs (y#ys)
else y#merge (x#xs) ys)"
thm merge.induct
lemma
shows "set (merge xs ys) = set xs \ set ys"
apply(induction xs ys rule: merge.induct)
apply auto
done
(*induction principles are just theorems like any other*)
theorem list_rev_induct:
assumes "P []"
and "\xs x. P xs \ P (xs@[x])"
shows "P xs"
using assms
apply -
apply(subst rev_rev_ident[symmetric])
apply(rule_tac list="rev xs" in list.induct)
apply force+
done
thm list_rev_induct
lemma
shows "foldr f xs e = foldl (\x y. f y x) e (rev xs)"
apply(induction xs rule: list_rev_induct)
oops (*IH too restricted again...*)
lemma
shows "foldr f xs e = foldl (\x y. f y x) e (rev xs)"
(*allow e to vary in inductive hypothesis*)
apply(induction xs arbitrary: e rule: list_rev_induct)
apply auto
done
(*note no need to introduce explicit universal quantifier*)
(*see other common induction principles:*)
thm list_induct2
thm measure_induct_rule (*mathematical induction using a "size" function*)
thm measure_induct_rule[where f="List.length"]
subsection\More in depth example: Tries\
(*maps: this will be useful below*)
term "(\x. None) :: 'a \ 'b option"
term "(\x. None) :: 'a \ 'b"
term "Map.empty"
term "(\x. if x = True then Some (0::nat) else None) :: bool \ nat"
term "Map.empty(True \ (0::nat))" (*function update*)
term "Map.map_of [(True, (0::nat))]"
(*tries as a recursive datatype*)
datatype ('k, 'v) trie
= Trie "'v option" "'k \ ('k, 'v) trie"
definition empty :: "('k, 'v) trie" where
"empty \ Trie None Map.empty"
fun lookup :: "'k seq \ ('k, 'v) trie \ 'v" where
"lookup \ (Trie v child) = v" |
"lookup (k \ ks) (Trie v child) =
(case child k of
None \ None
| Some c \ lookup ks c)"
fun insert :: "'k seq \ 'v \ ('k, 'v) trie \ ('k, 'v) trie" where
"insert \ v (Trie _ child) = Trie (Some v) child" |
"insert (k \ ks) v1 (Trie v2 child) =
(case child k of
None \ Trie v2 (child(k \ insert ks v1 empty))
| Some c \ Trie v2 (child(k \ insert ks v1 c)))"
lemma
shows "lookup ks (insert ks v t) = Some v"
apply(induction ks)
apply(case_tac t, simp)
apply(case_tac t, simp split!: option.split)
(*problem again: IH not applicable!*)
oops
lemma lookup_insert [simp]:
shows "lookup ks (insert ks v t) = Some v"
apply(induction ks arbitrary: t) (*allow t to vary in the inductive hypothesis*)
apply(case_tac t, clarify)
apply simp
apply(case_tac t, clarify)
apply(simp split!: option.split)
done
lemma insert_insert_overwrite [simp]:
assumes "ks1 = ks2"
shows "insert ks1 v1 (insert ks2 v2 t) = insert ks1 v1 t"
using assms
apply(induction ks1 arbitrary: t ks2) (*allow t and ks2 to vary in the inductive hypothesis*)
apply(case_tac t, clarify)
apply simp
apply(case_tac t, clarify)
apply(simp split!: option.split)
done
lemma insert_insert_permute:
assumes "ks1 \ ks2"
shows "insert ks1 v1 (insert ks2 v2 t) = insert ks2 v2 (insert ks1 v1 t)"
using assms
apply(induction ks1 arbitrary: t ks2)
apply(case_tac t, clarify)
apply(case_tac ks2)
apply simp
apply(simp split!: option.split)
apply(case_tac t, clarify)
apply(case_tac ks2)
apply(auto split!: option.split)
done
fun move_to :: "'k seq \ ('k, 'v) trie \ ('k, 'v) trie" where
"move_to \ t = Some t" |
"move_to (k \ ks) (Trie v child) =
(case child k of
None \ None
| Some c \ move_to ks c)"
lemma navigate_app:
shows "move_to (app ks ls) t =
(case move_to ks t of
None \ None
| Some t \ move_to ls t)" (*could have split this into two lemmas*)
apply(induction rule: move_to.induct)
apply simp
apply(simp split!: option.split)
done
subsection\Warning!\
(*embedding functions into datatypes is fine...*)
datatype good = Good "int \ int"
(*but you need to be careful with recursive occurrences of the
type being constructed:*)
datatype bad1 = Bad "bad1 \ int"
datatype bad2 = Bad "int \ bad2"
datatype bad3 = Bad "(int \ bad3) \ int"
(*HOL datatypes have a positivity condition that they must
satisfy (most "reasonable" datatypes do)*)
subsection\Lastly: records\
(*records are non-recursive in Isabelle*)
record processor =
memory :: "nat \ int option"
acc :: "int"
program_count :: "int"
program :: "int list"
print_theorems
(*record update syntax*)
term "(p::processor)\memory := Map.empty\"
(*fields are projected out like so*)
term "acc (p::processor)"
(*combining update and field projection*)
term "p\program_count := program_count p + 3\"
(*records are rarely used, can use datatypes with named projection
functions instead (relatively new feature):*)
datatype processor'
= Processor (memory: "nat \ int option") (acc: "int")
(program_counter: "int") (program: "int list")
term memory
term acc
end