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/smlnj-lib/Util/array-qsort-fn.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* array-qsort-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * Functor for in-place sorting of abstract arrays.
6 :     * Uses an engineered version of quicksort due to
7 :     * Bentley and McIlroy.
8 :     *
9 :     *)
10 :    
11 :     functor ArrayQSortFn (A : MONO_ARRAY) : MONO_ARRAY_SORT =
12 :     struct
13 :    
14 :     structure A = A
15 :    
16 :     fun isort (array, start, n, cmp) = let
17 :     fun item i = A.sub(array,i)
18 :     fun swap (i,j) = let
19 :     val tmp = A.sub(array,i)
20 :     in A.update(array,i,A.sub(array,j)); A.update(array,j,tmp) end
21 :     fun vecswap (i,j,0) = ()
22 :     | vecswap (i,j,n) = (swap(i,j);vecswap(i+1,j+1,n-1))
23 :     fun insertSort (start, n) = let
24 :     val limit = start+n
25 :     fun outer i =
26 :     if i >= limit then ()
27 :     else let
28 :     fun inner j =
29 :     if j = start then outer(i+1)
30 :     else let
31 :     val j' = j - 1
32 :     in
33 :     if cmp(item j',item j) = GREATER
34 :     then (swap(j,j'); inner j')
35 :     else outer(i+1)
36 :     end
37 :     in inner i end
38 :     in
39 :     outer (start+1)
40 :     end
41 :     in insertSort (start, n); array end
42 :    
43 :     fun sortRange (array, start, n, cmp) = let
44 :     fun item i = A.sub(array,i)
45 :     fun swap (i,j) = let
46 :     val tmp = A.sub(array,i)
47 :     in A.update(array,i,A.sub(array,j)); A.update(array,j,tmp) end
48 :     fun vecswap (i,j,0) = ()
49 :     | vecswap (i,j,n) = (swap(i,j);vecswap(i+1,j+1,n-1))
50 :     fun insertSort (start, n) = let
51 :     val limit = start+n
52 :     fun outer i =
53 :     if i >= limit then ()
54 :     else let
55 :     fun inner j =
56 :     if j = start then outer(i+1)
57 :     else let
58 :     val j' = j - 1
59 :     in
60 :     if cmp(item j',item j) = GREATER
61 :     then (swap(j,j'); inner j')
62 :     else outer(i+1)
63 :     end
64 :     in inner i end
65 :     in
66 :     outer (start+1)
67 :     end
68 :    
69 :     fun med3(a,b,c) = let
70 :     val a' = item a and b' = item b and c' = item c
71 :     in
72 :     case (cmp(a', b'),cmp(b', c'))
73 :     of (LESS, LESS) => b
74 :     | (LESS, _) => (
75 :     case cmp(a', c') of LESS => c | _ => a)
76 :     | (_, GREATER) => b
77 :     | _ => (case cmp(a', c') of LESS => a | _ => c)
78 :     (* end case *)
79 :     end
80 :    
81 :     fun getPivot (a,n) =
82 :     if n <= 7 then a + n div 2
83 :     else let
84 :     val p1 = a
85 :     val pm = a + n div 2
86 :     val pn = a + n - 1
87 :     in
88 :     if n <= 40 then med3(p1,pm,pn)
89 :     else let
90 :     val d = n div 8
91 :     val p1 = med3(p1,p1+d,p1+2*d)
92 :     val pm = med3(pm-d,pm,pm+d)
93 :     val pn = med3(pn-2*d,pn-d,pn)
94 :     in
95 :     med3(p1,pm,pn)
96 :     end
97 :     end
98 :    
99 :     fun quickSort (arg as (a, n)) = let
100 :     fun bottom limit = let
101 :     fun loop (arg as (pa,pb)) =
102 :     if pb > limit then arg
103 :     else case cmp(item pb,item a) of
104 :     GREATER => arg
105 :     | LESS => loop (pa,pb+1)
106 :     | _ => (swap arg; loop (pa+1,pb+1))
107 :     in loop end
108 :    
109 :     fun top limit = let
110 :     fun loop (arg as (pc,pd)) =
111 :     if limit > pc then arg
112 :     else case cmp(item pc,item a) of
113 :     LESS => arg
114 :     | GREATER => loop (pc-1,pd)
115 :     | _ => (swap arg; loop (pc-1,pd-1))
116 :     in loop end
117 :    
118 :     fun split (pa,pb,pc,pd) = let
119 :     val (pa,pb) = bottom pc (pa,pb)
120 :     val (pc,pd) = top pb (pc,pd)
121 :     in
122 :     if pb > pc then (pa,pb,pc,pd)
123 :     else (swap(pb,pc); split(pa,pb+1,pc-1,pd))
124 :     end
125 :    
126 :     val pm = getPivot arg
127 :     val _ = swap(a,pm)
128 :     val pa = a + 1
129 :     val pc = a + (n-1)
130 :     val (pa,pb,pc,pd) = split(pa,pa,pc,pc)
131 :     val pn = a + n
132 :     val r = Int.min(pa - a, pb - pa)
133 :     val _ = vecswap(a, pb-r, r)
134 :     val r = Int.min(pd - pc, pn - pd - 1)
135 :     val _ = vecswap(pb, pn-r, r)
136 :     val n' = pb - pa
137 :     val _ = if n' > 1 then sort(a,n') else ()
138 :     val n' = pd - pc
139 :     val _ = if n' > 1 then sort(pn-n',n') else ()
140 :     in () end
141 :    
142 :     and sort (arg as (_, n)) = if n < 7 then insertSort arg
143 :     else quickSort arg
144 :     in sort (start,n) end
145 :    
146 :     fun sort cmp array = sortRange(array,0,A.length array, cmp)
147 :    
148 :     fun sorted cmp array = let
149 :     val len = A.length array
150 :     fun s (v,i) = let
151 :     val v' = A.sub(array,i)
152 :     in
153 :     case cmp(v,v') of
154 :     GREATER => false
155 :     | _ => if i+1 = len then true else s(v',i+1)
156 :     end
157 :     in
158 :     if len = 0 orelse len = 1 then true
159 :     else s(A.sub(array,0),1)
160 :     end
161 :    
162 :     end (* ArraySortFn *)
163 :    

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