Home My Page Projects Code Snippets Project Openings SML/NJ
 Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/smlnj-lib/Util/array-qsort.sml
 [smlnj] / sml / trunk / src / smlnj-lib / Util / array-qsort.sml

View of /sml/trunk/src/smlnj-lib/Util/array-qsort.sml

Thu Jun 1 18:34:03 2000 UTC (19 years, 3 months ago) by monnier
File size: 5999 byte(s)
```bring revisions from the vendor branch to the trunk
```
```(* array-qsort.sml
*
* COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
*
* Structure for in-place sorting of polymorphic arrays.
* Uses an engineered version of quicksort due to
* Bentley and McIlroy.
*
*)

structure ArrayQSort : ARRAY_SORT =
struct

structure A = Array

type 'a array = 'a A.array

val sub = Unsafe.Array.sub
val update = Unsafe.Array.update

fun isort (array, start, n, cmp) = let
fun item i = sub(array,i)
fun swap (i,j) = let
val tmp = sub(array,i)
in update(array,i,sub(array,j)); update(array,j,tmp) end
fun vecswap (i,j,0) = ()
| vecswap (i,j,n) = (swap(i,j);vecswap(i+1,j+1,n-1))
fun insertSort (start, n) = let
val limit = start+n
fun outer i =
if i >= limit then ()
else let
fun inner j =
if j = start then outer(i+1)
else let
val j' = j - 1
in
if cmp(item j',item j) = GREATER
then (swap(j,j'); inner j')
else outer(i+1)
end
in inner i end
in
outer (start+1)
end
in insertSort (start, n); array end

fun sortRange (array, start, n, cmp) = let
fun item i = sub(array,i)
fun swap (i,j) = let
val tmp = sub(array,i)
in update(array,i,sub(array,j)); update(array,j,tmp) end
fun vecswap (i,j,0) = ()
| vecswap (i,j,n) = (swap(i,j);vecswap(i+1,j+1,n-1))
fun insertSort (start, n) = let
val limit = start+n
fun outer i =
if i >= limit then ()
else let
fun inner j =
if j = start then outer(i+1)
else let
val j' = j - 1
in
if cmp(item j',item j) = GREATER
then (swap(j,j'); inner j')
else outer(i+1)
end
in inner i end
in
outer (start+1)
end

fun med3(a,b,c) = let
val a' = item a and b' = item b and c' = item c
in
case (cmp(a', b'),cmp(b', c'))
of (LESS, LESS) => b
| (LESS, _) => (
case cmp(a', c') of LESS => c | _ => a)
| (_, GREATER) => b
| _ => (case cmp(a', c') of LESS => a | _ => c)
(* end case *)
end

fun getPivot (a,n) =
if n <= 7 then a + n div 2
else let
val p1 = a
val pm = a + n div 2
val pn = a + n - 1
in
if n <= 40 then med3(p1,pm,pn)
else let
val d = n div 8
val p1 = med3(p1,p1+d,p1+2*d)
val pm = med3(pm-d,pm,pm+d)
val pn = med3(pn-2*d,pn-d,pn)
in
med3(p1,pm,pn)
end
end

fun quickSort (arg as (a, n)) = let
fun bottom limit = let
fun loop (arg as (pa,pb)) =
if pb > limit then arg
else case cmp(item pb,item a) of
GREATER => arg
| LESS => loop (pa,pb+1)
| _ => (swap arg; loop (pa+1,pb+1))
in loop end

fun top limit = let
fun loop (arg as (pc,pd)) =
if limit > pc then arg
else case cmp(item pc,item a) of
LESS => arg
| GREATER => loop (pc-1,pd)
| _ => (swap arg; loop (pc-1,pd-1))
in loop end

fun split (pa,pb,pc,pd) = let
val (pa,pb) = bottom pc (pa,pb)
val (pc,pd) = top pb (pc,pd)
in
if pb > pc then (pa,pb,pc,pd)
else (swap(pb,pc); split(pa,pb+1,pc-1,pd))
end

val pm = getPivot arg
val _ = swap(a,pm)
val pa = a + 1
val pc = a + (n-1)
val (pa,pb,pc,pd) = split(pa,pa,pc,pc)
val pn = a + n
val r = Int.min(pa - a, pb - pa)
val _ = vecswap(a, pb-r, r)
val r = Int.min(pd - pc, pn - pd - 1)
val _ = vecswap(pb, pn-r, r)
val n' = pb - pa
val _ = if n' > 1 then sort(a,n') else ()
val n' = pd - pc
val _ = if n' > 1 then sort(pn-n',n') else ()
in () end

and sort (arg as (_, n)) = if n < 7 then insertSort arg
else quickSort arg
in sort (start,n) end

fun sort cmp array = sortRange(array, 0, A.length array, cmp)

fun sorted cmp array = let
val len = A.length array
fun s (v,i) = let
val v' = sub(array,i)
in
case cmp(v,v') of
GREATER => false
| _ => if i+1 = len then true else s(v',i+1)
end
in
if len = 0 orelse len = 1 then true
else s(sub(array,0),1)
end

end (* ArraySort *)

```