src/HOL/ex/MergeSort.thy
author wenzelm
Mon, 16 Mar 2009 18:24:30 +0100
changeset 30549 d2d7874648bd
parent 29780 1df0e5af40b9
child 30661 54858c8ad226
permissions -rw-r--r--
simplified method setup;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/ex/Merge.thy
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     2
    ID:         $Id$
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     3
    Author:     Tobias Nipkow
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     4
    Copyright   2002 TU Muenchen
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     5
*)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     6
15815
paulson
parents: 15732
diff changeset
     7
header{*Merge Sort*}
paulson
parents: 15732
diff changeset
     8
paulson
parents: 15732
diff changeset
     9
theory MergeSort
paulson
parents: 15732
diff changeset
    10
imports Sorting
paulson
parents: 15732
diff changeset
    11
begin
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    12
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    13
context linorder
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    14
begin
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    15
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    16
fun merge :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    17
where
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    18
  "merge (x#xs) (y#ys) =
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    19
         (if x \<le> y then x # merge xs (y#ys) else y # merge (x#xs) ys)"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    20
| "merge xs [] = xs"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    21
| "merge [] ys = ys"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    22
15732
faa48c5b1402 Added thm names
nipkow
parents: 15631
diff changeset
    23
lemma multiset_of_merge[simp]:
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    24
     "multiset_of (merge xs ys) = multiset_of xs + multiset_of ys"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    25
apply(induct xs ys rule: merge.induct)
15631
cbee04ce413b use Library/Multiset instead of own definition
kleing
parents: 13201
diff changeset
    26
apply (auto simp: union_ac)
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    27
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    28
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    29
lemma set_merge[simp]: "set (merge xs ys) = set xs \<union> set ys"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    30
apply(induct xs ys rule: merge.induct)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    31
apply auto
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    32
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    33
15732
faa48c5b1402 Added thm names
nipkow
parents: 15631
diff changeset
    34
lemma sorted_merge[simp]:
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    35
     "sorted (op \<le>) (merge xs ys) = (sorted (op \<le>) xs & sorted (op \<le>) ys)"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    36
apply(induct xs ys rule: merge.induct)
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    37
apply(simp_all add: ball_Un not_le less_le)
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    38
apply(blast intro: order_trans)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    39
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    40
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    41
fun msort :: "'a list \<Rightarrow> 'a list"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    42
where
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    43
  "msort [] = []"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    44
| "msort [x] = [x]"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    45
| "msort xs = merge (msort (take (size xs div 2) xs))
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    46
	                  (msort (drop (size xs div 2) xs))"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    47
15815
paulson
parents: 15732
diff changeset
    48
theorem sorted_msort: "sorted (op \<le>) (msort xs)"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    49
by (induct xs rule: msort.induct) simp_all
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    50
15815
paulson
parents: 15732
diff changeset
    51
theorem multiset_of_msort: "multiset_of (msort xs) = multiset_of xs"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    52
apply (induct xs rule: msort.induct)
15815
paulson
parents: 15732
diff changeset
    53
  apply simp_all
19872
1b53b196f85f corrected w.r.t. search order for subst.
dixon
parents: 19860
diff changeset
    54
apply (subst union_commute)
15631
cbee04ce413b use Library/Multiset instead of own definition
kleing
parents: 13201
diff changeset
    55
apply (simp del:multiset_of_append add:multiset_of_append[symmetric] union_assoc)
cbee04ce413b use Library/Multiset instead of own definition
kleing
parents: 13201
diff changeset
    56
apply (simp add: union_ac)
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    57
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    58
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    59
end
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    60
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    61
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    62
end