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/left-priorityq-fn.sml
ViewVC logotype

Annotation of /smlnj-lib/trunk/Util/left-priorityq-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2144 - (view) (download)

1 : jhr 1061 (* left-priorityq-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
4 :     *
5 :     * An implementation of priority queues based on leaftist heaps (see
6 :     * Purely Functional Data Structures by Chris Okasaki).
7 :     *)
8 :    
9 :     functor LeftPriorityQFn (P : PRIORITY) : MONO_PRIORITYQ =
10 :     struct
11 :    
12 :     type item = P.item
13 :    
14 :     datatype queue = Q of (int * heap)
15 :     and heap = EMPTY | ND of (int * item * heap * heap)
16 :    
17 :     val empty = Q(0, EMPTY)
18 :    
19 : jhr 1788 fun singletonHeap x = ND(1, x, EMPTY, EMPTY)
20 :     fun singleton x = Q(1, singletonHeap x)
21 : jhr 1061
22 :     fun rank EMPTY = 0
23 :     | rank (ND(r, _, _, _)) = r
24 :    
25 :     fun mkNode (x, a, b) = if (rank a >= rank b)
26 :     then ND(rank b + 1, x, a, b)
27 :     else ND(rank a + 1, x, b, a)
28 :    
29 :     fun mergeHeap (h, EMPTY) = h
30 :     | mergeHeap (EMPTY, h) = h
31 :     | mergeHeap (h1 as ND(_, x, h11, h12), h2 as ND(_, y, h21, h22)) = (
32 :     case P.compare(P.priority x, P.priority y)
33 :     of GREATER => mkNode(x, h11, mergeHeap(h12, h2))
34 :     | _ => mkNode(y, h21, mergeHeap(h1, h22))
35 :     (* end case *))
36 :    
37 : jhr 1788 fun insert (x, Q(n, h)) = Q(n+1, mergeHeap(singletonHeap x, h))
38 : jhr 1061
39 :     fun next (Q(_, EMPTY)) = NONE
40 :     | next (Q(n, ND(_, x, h1, h2))) = SOME(x, Q(n-1, mergeHeap(h1, h2)))
41 :    
42 :     fun remove (Q(_, EMPTY)) = raise List.Empty
43 :     | remove (Q(n, ND(_, x, h1, h2))) = (x, Q(n-1, mergeHeap(h1, h2)))
44 :    
45 :     fun merge (Q(n1, h1), Q(n2, h2)) = Q(n1+n2, mergeHeap(h1, h2))
46 :    
47 :     fun numItems (Q(n, _)) = n
48 :    
49 :     fun isEmpty (Q(_, EMPTY)) = true
50 :     | isEmpty _ = false
51 :    
52 :     fun fromList [] = empty
53 : jhr 1788 | fromList [x] = Q(1, singletonHeap x)
54 : jhr 1061 | fromList l = let
55 : jhr 1081 fun init ([], n, items) = (n, items)
56 : jhr 1788 | init (x::r, n, items) = init (r, n+1, singletonHeap x :: items)
57 : jhr 1061 fun merge ([], [h]) = h
58 :     | merge ([], hl) = merge (hl, [])
59 :     | merge ([h], hl) = merge (h::hl, [])
60 :     | merge (h1::h2::r, l) = merge (r, mergeHeap(h1, h2) :: l)
61 : jhr 1081 val (len, hs) = init (l, 0, [])
62 : jhr 1061 in
63 : jhr 1081 Q(len, merge (hs, []))
64 : jhr 1061 end
65 :    
66 :     end;

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