src/HOL/Library/Quicksort.thy
author haftmann
Fri, 11 Jun 2010 17:14:02 +0200
changeset 37407 61dd8c145da7
parent 37075 a680ce27aa56
permissions -rw-r--r--
declare lex_prod_def [code del]
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
30738
0842e906300c normalized imports
haftmann
parents: 28041
diff changeset
     1
(*  Author:     Tobias Nipkow
24615
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
     2
    Copyright   1994 TU Muenchen
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
     3
*)
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
     4
37075
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
     5
header {* Quicksort *}
24615
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
     6
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
     7
theory Quicksort
30738
0842e906300c normalized imports
haftmann
parents: 28041
diff changeset
     8
imports Main Multiset
24615
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
     9
begin
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    10
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    11
context linorder
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    12
begin
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    13
28041
f496e9f343b7 quicksort: function -> fun
krauss
parents: 27682
diff changeset
    14
fun quicksort :: "'a list \<Rightarrow> 'a list" where
37075
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    15
  "quicksort []     = []"
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    16
| "quicksort (x#xs) = quicksort [y\<leftarrow>xs. \<not> x\<le>y] @ [x] @ quicksort [y\<leftarrow>xs. x\<le>y]"
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    17
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    18
lemma [code]:
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    19
  "quicksort []     = []"
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    20
  "quicksort (x#xs) = quicksort [y\<leftarrow>xs. y<x] @ [x] @ quicksort [y\<leftarrow>xs. x\<le>y]"
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    21
  by (simp_all add: not_le)
24615
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    22
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    23
lemma quicksort_permutes [simp]:
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    24
  "multiset_of (quicksort xs) = multiset_of xs"
37075
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    25
  by (induct xs rule: quicksort.induct) (simp_all add: ac_simps)
24615
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    26
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    27
lemma set_quicksort [simp]: "set (quicksort xs) = set xs"
37075
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    28
  by (simp add: set_count_greater_0)
24615
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    29
37075
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    30
lemma sorted_quicksort: "sorted (quicksort xs)"
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    31
  by (induct xs rule: quicksort.induct) (auto simp add: sorted_Cons sorted_append not_le less_imp_le)
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    32
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    33
theorem quicksort_sort [code_unfold]:
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    34
  "sort = quicksort"
a680ce27aa56 modernized sorting algorithms; quicksort implements sort
haftmann
parents: 30738
diff changeset
    35
  by (rule ext, rule properties_for_sort) (fact quicksort_permutes sorted_quicksort)+
24615
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    36
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    37
end
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    38
17dbd993293d Added function package to PreList
nipkow
parents:
diff changeset
    39
end