src/HOL/ex/MergeSort.thy
author kleing
Mon, 19 Apr 2004 09:31:00 +0200
changeset 14626 dfb8d2977263
parent 13201 3cc108872aca
child 15631 cbee04ce413b
permissions -rw-r--r--
renamed HOL-Import-HOL to HOL4, added to images target
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
Merge sort
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     7
*)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     8
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
     9
theory MergeSort = Sorting:
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    10
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    11
consts merge :: "('a::linorder)list * 'a list \<Rightarrow> 'a list"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    12
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    13
recdef merge "measure(%(xs,ys). size xs + size ys)"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    14
"merge(x#xs,y#ys) =
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    15
 (if x <= y then x # merge(xs,y#ys) else y # merge(x#xs,ys))"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    16
"merge(xs,[]) = xs"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    17
"merge([],ys) = ys"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    18
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    19
lemma [simp]: "multiset(merge(xs,ys)) x = multiset xs x + multiset ys x"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    20
apply(induct xs ys rule: merge.induct)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    21
apply auto
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    22
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    23
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    24
lemma [simp]: "set(merge(xs,ys)) = set xs \<union> set ys"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    25
apply(induct xs ys rule: merge.induct)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    26
apply auto
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    27
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    28
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    29
lemma [simp]:
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    30
 "sorted (op <=) (merge(xs,ys)) = (sorted (op <=) xs & sorted (op <=) ys)"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    31
apply(induct xs ys rule: merge.induct)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    32
apply(simp_all add:ball_Un linorder_not_le order_less_le)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    33
apply(blast intro: order_trans)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    34
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    35
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    36
consts msort :: "('a::linorder) list \<Rightarrow> 'a list"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    37
recdef msort "measure size"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    38
"msort [] = []"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    39
"msort [x] = [x]"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    40
"msort xs = merge(msort(take (size xs div 2) xs),
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    41
                  msort(drop (size xs div 2) xs))"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    42
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    43
lemma "sorted op <= (msort xs)"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    44
by (induct xs rule: msort.induct) simp_all
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    45
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    46
lemma "multiset(msort xs) x = multiset xs x"
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    47
apply (induct xs rule: msort.induct)
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    48
  apply simp
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    49
 apply simp
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    50
apply (simp del:multiset_append add:multiset_append[symmetric])
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    51
done
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    52
3cc108872aca *** empty log message ***
nipkow
parents:
diff changeset
    53
end