author | blanchet |
Wed, 15 Dec 2010 11:26:28 +0100 | |
changeset 41140 | 9c68004b8c9d |
parent 37076 | 4d57f872dc2c |
child 41413 | 64cd30d6b0b8 |
permissions | -rw-r--r-- |
34055 | 1 |
(* Title: HOL/ex/MergeSort.thy |
13201 | 2 |
Author: Tobias Nipkow |
3 |
Copyright 2002 TU Muenchen |
|
4 |
*) |
|
5 |
||
15815 | 6 |
header{*Merge Sort*} |
7 |
||
8 |
theory MergeSort |
|
37076
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
9 |
imports Multiset |
15815 | 10 |
begin |
13201 | 11 |
|
29780 | 12 |
context linorder |
13 |
begin |
|
13201 | 14 |
|
29780 | 15 |
fun merge :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" |
16 |
where |
|
17 |
"merge (x#xs) (y#ys) = |
|
18 |
(if x \<le> y then x # merge xs (y#ys) else y # merge (x#xs) ys)" |
|
19 |
| "merge xs [] = xs" |
|
20 |
| "merge [] ys = ys" |
|
13201 | 21 |
|
37076
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
22 |
lemma multiset_of_merge [simp]: |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
23 |
"multiset_of (merge xs ys) = multiset_of xs + multiset_of ys" |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
24 |
by (induct xs ys rule: merge.induct) (simp_all add: ac_simps) |
13201 | 25 |
|
37076
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
26 |
lemma set_merge [simp]: |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
27 |
"set (merge xs ys) = set xs \<union> set ys" |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
28 |
by (induct xs ys rule: merge.induct) auto |
13201 | 29 |
|
37076
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
30 |
lemma sorted_merge [simp]: |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
31 |
"sorted (merge xs ys) \<longleftrightarrow> sorted xs \<and> sorted ys" |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
32 |
by (induct xs ys rule: merge.induct) (auto simp add: ball_Un not_le less_le sorted_Cons) |
13201 | 33 |
|
29780 | 34 |
fun msort :: "'a list \<Rightarrow> 'a list" |
35 |
where |
|
36 |
"msort [] = []" |
|
37 |
| "msort [x] = [x]" |
|
38 |
| "msort xs = merge (msort (take (size xs div 2) xs)) |
|
32960
69916a850301
eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents:
30661
diff
changeset
|
39 |
(msort (drop (size xs div 2) xs))" |
13201 | 40 |
|
37076
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
41 |
lemma sorted_msort: |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
42 |
"sorted (msort xs)" |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
43 |
by (induct xs rule: msort.induct) simp_all |
13201 | 44 |
|
37076
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
45 |
lemma multiset_of_msort: |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
46 |
"multiset_of (msort xs) = multiset_of xs" |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
47 |
by (induct xs rule: msort.induct) |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
48 |
(simp_all, metis append_take_drop_id drop_Suc_Cons multiset_of.simps(2) multiset_of_append take_Suc_Cons) |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
49 |
|
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
50 |
theorem msort_sort: |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
51 |
"sort = msort" |
4d57f872dc2c
modernized sorting algorithms; quicksort implements sort
haftmann
parents:
34055
diff
changeset
|
52 |
by (rule ext, rule properties_for_sort) (fact multiset_of_msort sorted_msort)+ |
13201 | 53 |
|
54 |
end |
|
29780 | 55 |
|
56 |
end |