| author | wenzelm | 
| Sun, 28 Apr 2019 22:22:29 +0200 | |
| changeset 70207 | 511352b4d5d3 | 
| parent 68440 | 6826718f732d | 
| child 71463 | a31a9da43694 | 
| permissions | -rw-r--r-- | 
| 61640 | 1  | 
(* Author: Tobias Nipkow *)  | 
2  | 
||
| 
63411
 
e051eea34990
got rid of class cmp; added height-size proofs by Daniel Stuewe
 
nipkow 
parents: 
61678 
diff
changeset
 | 
3  | 
section \<open>Unbalanced Tree Implementation of Set\<close>  | 
| 61640 | 4  | 
|
5  | 
theory Tree_Set  | 
|
6  | 
imports  | 
|
| 
66453
 
cc19f7ca2ed6
session-qualified theory imports: isabelle imports -U -i -d '~~/src/Benchmarks' -a;
 
wenzelm 
parents: 
63411 
diff
changeset
 | 
7  | 
"HOL-Library.Tree"  | 
| 61640 | 8  | 
Cmp  | 
| 67965 | 9  | 
Set_Specs  | 
| 61640 | 10  | 
begin  | 
11  | 
||
| 68431 | 12  | 
definition empty :: "'a tree" where  | 
13  | 
"empty == Leaf"  | 
|
14  | 
||
| 
63411
 
e051eea34990
got rid of class cmp; added height-size proofs by Daniel Stuewe
 
nipkow 
parents: 
61678 
diff
changeset
 | 
15  | 
fun isin :: "'a::linorder tree \<Rightarrow> 'a \<Rightarrow> bool" where  | 
| 61640 | 16  | 
"isin Leaf x = False" |  | 
17  | 
"isin (Node l a r) x =  | 
|
| 61678 | 18  | 
(case cmp x a of  | 
19  | 
LT \<Rightarrow> isin l x |  | 
|
20  | 
EQ \<Rightarrow> True |  | 
|
21  | 
GT \<Rightarrow> isin r x)"  | 
|
| 61640 | 22  | 
|
23  | 
hide_const (open) insert  | 
|
24  | 
||
| 
63411
 
e051eea34990
got rid of class cmp; added height-size proofs by Daniel Stuewe
 
nipkow 
parents: 
61678 
diff
changeset
 | 
25  | 
fun insert :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where  | 
| 61640 | 26  | 
"insert x Leaf = Node Leaf x Leaf" |  | 
| 61678 | 27  | 
"insert x (Node l a r) =  | 
28  | 
(case cmp x a of  | 
|
29  | 
LT \<Rightarrow> Node (insert x l) a r |  | 
|
30  | 
EQ \<Rightarrow> Node l a r |  | 
|
31  | 
GT \<Rightarrow> Node l a (insert x r))"  | 
|
| 61640 | 32  | 
|
| 68020 | 33  | 
fun split_min :: "'a tree \<Rightarrow> 'a * 'a tree" where  | 
34  | 
"split_min (Node l a r) =  | 
|
35  | 
(if l = Leaf then (a,r) else let (x,l') = split_min l in (x, Node l' a r))"  | 
|
| 61640 | 36  | 
|
| 
63411
 
e051eea34990
got rid of class cmp; added height-size proofs by Daniel Stuewe
 
nipkow 
parents: 
61678 
diff
changeset
 | 
37  | 
fun delete :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where  | 
| 61640 | 38  | 
"delete x Leaf = Leaf" |  | 
| 61678 | 39  | 
"delete x (Node l a r) =  | 
40  | 
(case cmp x a of  | 
|
41  | 
LT \<Rightarrow> Node (delete x l) a r |  | 
|
42  | 
GT \<Rightarrow> Node l a (delete x r) |  | 
|
| 68020 | 43  | 
EQ \<Rightarrow> if r = Leaf then l else let (a',r') = split_min r in Node l a' r')"  | 
| 61640 | 44  | 
|
45  | 
||
46  | 
subsection "Functional Correctness Proofs"  | 
|
47  | 
||
| 67929 | 48  | 
lemma isin_set: "sorted(inorder t) \<Longrightarrow> isin t x = (x \<in> set (inorder t))"  | 
49  | 
by (induction t) (auto simp: isin_simps)  | 
|
| 61640 | 50  | 
|
51  | 
lemma inorder_insert:  | 
|
52  | 
"sorted(inorder t) \<Longrightarrow> inorder(insert x t) = ins_list x (inorder t)"  | 
|
53  | 
by(induction t) (auto simp: ins_list_simps)  | 
|
54  | 
||
55  | 
||
| 68020 | 56  | 
lemma split_minD:  | 
57  | 
"split_min t = (x,t') \<Longrightarrow> t \<noteq> Leaf \<Longrightarrow> x # inorder t' = inorder t"  | 
|
58  | 
by(induction t arbitrary: t' rule: split_min.induct)  | 
|
| 61647 | 59  | 
(auto simp: sorted_lems split: prod.splits if_splits)  | 
| 61640 | 60  | 
|
61  | 
lemma inorder_delete:  | 
|
62  | 
"sorted(inorder t) \<Longrightarrow> inorder(delete x t) = del_list x (inorder t)"  | 
|
| 68020 | 63  | 
by(induction t) (auto simp: del_list_simps split_minD split: prod.splits)  | 
| 61640 | 64  | 
|
| 68440 | 65  | 
interpretation S: Set_by_Ordered  | 
| 68431 | 66  | 
where empty = empty and isin = isin and insert = insert and delete = delete  | 
| 61640 | 67  | 
and inorder = inorder and inv = "\<lambda>_. True"  | 
68  | 
proof (standard, goal_cases)  | 
|
| 68431 | 69  | 
case 1 show ?case by (simp add: empty_def)  | 
| 61640 | 70  | 
next  | 
71  | 
case 2 thus ?case by(simp add: isin_set)  | 
|
72  | 
next  | 
|
73  | 
case 3 thus ?case by(simp add: inorder_insert)  | 
|
74  | 
next  | 
|
75  | 
case 4 thus ?case by(simp add: inorder_delete)  | 
|
76  | 
qed (rule TrueI)+  | 
|
77  | 
||
78  | 
end  |