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

SCM Repository

[smlnj] Annotation of /sml/trunk/src/comp-lib/sort.sml
ViewVC logotype

Annotation of /sml/trunk/src/comp-lib/sort.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 246 - (view) (download)

1 : monnier 245 (* Copyright 1989 by AT&T Bell Laboratories *)
2 :     signature SORT =
3 :     sig
4 :     (* pass the gt predicate as an argument *)
5 :     val sort : ('a * 'a -> bool) -> 'a list -> 'a list
6 :     val sorted : ('a * 'a -> bool) -> 'a list -> bool
7 :     end
8 :    
9 :     structure Sort : SORT = struct
10 :    
11 :     (* Industrial-strength quicksort.
12 :     Selects pivot from middle of input list.
13 :     Distributes elements equal to pivot "randomly" in the two output partitions.
14 :     Special-cases lists of 0, 1, or 2 elements.
15 :     *)
16 :     fun sort (op > : ('x * 'x -> bool)) =
17 :     let fun splita(pivot,nil,less,greater)= qsort less @ (pivot :: qsort greater)
18 :     | splita(pivot,a::rest,less,greater) =
19 :     if a>pivot then splitb(pivot,rest,less,a::greater)
20 :     else splitb(pivot,rest,a::less,greater)
21 :     and splitb(pivot,nil,less,greater)= qsort less @ (pivot :: qsort greater)
22 :     | splitb(pivot,a::rest,less,greater) =
23 :     if pivot>a then splita(pivot,rest,a::less,greater)
24 :     else splita(pivot,rest,less,a::greater)
25 :     and split1a(pivot,0,_::r,less,greater) = splitb(pivot,r,less,greater)
26 :     | split1a(pivot,i,a::rest,less,greater) =
27 :     if a>pivot then split1b(pivot,i-1,rest,less,a::greater)
28 :     else split1b(pivot,i-1,rest,a::less,greater)
29 :     and split1b(pivot,0,_::r,less,greater) = splita(pivot,r,less,greater)
30 :     | split1b(pivot,i,a::rest,less,greater) =
31 :     if pivot>a then split1a(pivot,i-1,rest,a::less,greater)
32 :     else split1a(pivot,i-1,rest,less,a::greater)
33 :     and qsort (l as [a,b]) = if a>b then [b,a] else l
34 :     | qsort (l as _::_::_) =
35 :     let fun getpivot (x::xr, _::_::rest, i) = getpivot(xr,rest,i+1)
36 :     | getpivot (x::_, _,i) = split1a(x,i,l,nil,nil)
37 :     in getpivot(l,l,0)
38 :     end
39 :     | qsort l = l
40 :     in qsort
41 :     end
42 :    
43 :     (* smooth applicative merge sort
44 :     * Taken from, ML for the Working Programmer, LCPaulson. pg 99-100
45 :     *)
46 :     fun sort (op > : 'a * 'a -> bool) ls =
47 :     let fun merge([],ys) = ys
48 :     | merge(xs,[]) = xs
49 :     | merge(x::xs,y::ys) =
50 :     if x > y then y::merge(x::xs,ys) else x::merge(xs,y::ys)
51 :     fun mergepairs(ls as [l], k) = ls
52 :     | mergepairs(l1::l2::ls,k) =
53 :     if k mod 2 = 1 then l1::l2::ls
54 :     else mergepairs(merge(l1,l2)::ls, k div 2)
55 :     fun nextrun(run,[]) = (rev run,[])
56 :     | nextrun(run,x::xs) = if x > hd run then nextrun(x::run,xs)
57 :     else (rev run,x::xs)
58 :     fun samsorting([], ls, k) = hd(mergepairs(ls,0))
59 :     | samsorting(x::xs, ls, k) =
60 :     let val (run,tail) = nextrun([x],xs)
61 :     in samsorting(tail, mergepairs(run::ls,k+1), k+1)
62 :     end
63 :     in case ls of [] => [] | _ => samsorting(ls, [], 0)
64 :     end
65 :    
66 :     fun sorted (op >) =
67 :     let fun s (x::(rest as (y::_))) = not(x>y) andalso s rest
68 :     | s l = true
69 :     in s
70 :     end
71 :    
72 :     end
73 :    
74 :     (*
75 :     * $Log$
76 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0