src/HOL/ex/MergeSort.thy
author nipkow
Fri, 19 Jun 2015 15:55:22 +0200
changeset 60515 484559628038
parent 58889 5b7a9633cfa8
child 61343 5b5656a63bd6
permissions -rw-r--r--
renamed multiset_of -> mset
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
34055
fdf294ee08b2 streamlined proofs
paulson
parents: 32960
diff changeset
     1
(*  Title:      HOL/ex/MergeSort.thy
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     2
    Author:     Tobias Nipkow
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     3
    Copyright   2002 TU Muenchen
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     4
*)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     5
58889
5b7a9633cfa8 modernized header uniformly as section;
wenzelm
parents: 41413
diff changeset
     6
section{*Merge Sort*}
15815
paulson
parents: 15732
diff changeset
     7
paulson
parents: 15732
diff changeset
     8
theory MergeSort
41413
64cd30d6b0b8 explicit file specifications -- avoid secondary load path;
wenzelm
parents: 37076
diff changeset
     9
imports "~~/src/HOL/Library/Multiset"
15815
paulson
parents: 15732
diff changeset
    10
begin
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    11
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    12
context linorder
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    13
begin
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    14
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    15
fun merge :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    16
where
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    17
  "merge (x#xs) (y#ys) =
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    18
         (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
    19
| "merge xs [] = xs"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    20
| "merge [] ys = ys"
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    21
60515
484559628038 renamed multiset_of -> mset
nipkow
parents: 58889
diff changeset
    22
lemma mset_merge [simp]:
484559628038 renamed multiset_of -> mset
nipkow
parents: 58889
diff changeset
    23
  "mset (merge xs ys) = mset xs + mset ys"
37076
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
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    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
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    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
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    33
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    34
fun msort :: "'a list \<Rightarrow> 'a list"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    35
where
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    36
  "msort [] = []"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    37
| "msort [x] = [x]"
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    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
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    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
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    44
60515
484559628038 renamed multiset_of -> mset
nipkow
parents: 58889
diff changeset
    45
lemma mset_msort:
484559628038 renamed multiset_of -> mset
nipkow
parents: 58889
diff changeset
    46
  "mset (msort xs) = mset xs"
37076
4d57f872dc2c modernized sorting algorithms; quicksort implements sort
haftmann
parents: 34055
diff changeset
    47
  by (induct xs rule: msort.induct)
60515
484559628038 renamed multiset_of -> mset
nipkow
parents: 58889
diff changeset
    48
    (simp_all, metis append_take_drop_id drop_Suc_Cons mset.simps(2) mset_append take_Suc_Cons)
37076
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"
60515
484559628038 renamed multiset_of -> mset
nipkow
parents: 58889
diff changeset
    52
  by (rule ext, rule properties_for_sort) (fact mset_msort sorted_msort)+
13201
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    53
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    54
end
29780
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    55
1df0e5af40b9 mergesort example: recdef->fun, localized
krauss
parents: 19872
diff changeset
    56
end