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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)
Original Path: sml/trunk/src/smlnj-lib/Util/array-qsort.sml

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

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