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 /MLRISC/trunk/graphs/orig-node-priqueue.sml
ViewVC logotype

Annotation of /MLRISC/trunk/graphs/orig-node-priqueue.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1350 - (view) (download)
Original Path: sml/trunk/src/MLRISC/graphs/orig-node-priqueue.sml

1 : mblume 1350 (*
2 :     * This implements a priority queue for nodes in a graph
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 :     functor NodePriorityQueue(A : ARRAY) : NODE_PRIORITY_QUEUE =
8 :     struct
9 :     structure G = Graph
10 :    
11 :     exception EmptyPriorityQueue
12 :    
13 :     datatype node_priority_queue =
14 :     Q of { less : G.node_id * G.node_id -> bool,
15 :     heap : G.node_id A.array,
16 :     pos : int A.array,
17 :     size : int ref
18 :     }
19 :     fun create N less = Q { less = less,
20 :     heap = A.array(N,0),
21 :     pos = A.array(N,0),
22 :     size = ref 0
23 :     }
24 :    
25 :     fun isEmpty (Q{ size = ref 0, ... }) = true
26 :     | isEmpty _ = false
27 :    
28 :     fun clear (Q{ size, ... }) = size := 0
29 :    
30 :     fun min(Q{ size = ref 0, ... }) = raise EmptyPriorityQueue
31 :     | min(Q{ heap, ... }) = A.sub(heap, 0)
32 :    
33 :     fun decreaseWeight(Q{ size, heap, pos, less }, x) =
34 :     let fun siftup 0 = 0
35 :     | siftup i =
36 :     let val j = (i-1) div 2
37 :     val y = A.sub(heap,j)
38 :     in if less(x,y) then (A.update(heap,i,y); A.update(pos,y,i); siftup j)
39 :     else i
40 :     end
41 :     val x_pos = siftup(A.sub(pos,x))
42 :     in A.update(heap,x_pos,x); A.update(pos,x,x_pos)
43 :     end
44 :    
45 :     fun insert(q as Q{ size, heap, pos, ...}, x) =
46 :     let val N = !size
47 :     in A.update(heap,N,x); A.update(pos,x,N); size := N + 1;
48 :     decreaseWeight(q,x)
49 :     end
50 :    
51 :     fun deleteMin(Q{ size = ref 0, ...}) = raise EmptyPriorityQueue
52 :     | deleteMin(Q{ size, heap, pos, less}) =
53 :     let val N = !size - 1
54 :     fun siftdown (i,x) =
55 :     let val j = i + i + 1
56 :     val k = j + 1
57 :     in if j >= N then i
58 :     else let val y = A.sub(heap,j)
59 :     in if k >= N then
60 :     if less(y,x) then go(i,x,j,y) else i
61 :     else
62 :     let val z = A.sub(heap,k)
63 :     in if less(y,x) then
64 :     if less(z,y) then go(i,x,k,z)
65 :     else go(i,x,j,y)
66 :     else if less(z,x) then go(i,x,k,z)
67 :     else i
68 :     end
69 :     end
70 :     end
71 :     and go(i,x,j,y) = (A.update(heap,i,y); A.update(pos,y,i); siftdown(j,x))
72 :     val min = A.sub(heap,0)
73 :     val x = A.sub(heap,N)
74 :     val x_pos = siftdown(0, x)
75 :     in A.update(heap,x_pos,x); A.update(pos,x,x_pos);
76 :     size := N;
77 :     min
78 :     end
79 :    
80 :     fun fromGraph less (G.GRAPH G) =
81 :     let val N = #order G ()
82 :     val heap = A.array(N,0)
83 :     val pos = A.array(#capacity G (),0)
84 :     fun siftdown (i,x) =
85 :     let val j = i*2 + 1
86 :     val k = j + 1
87 :     in if j >= N then A.update(heap,i,x)
88 :     else if k >= N then
89 :     let val y = A.sub(heap,j)
90 :     in if less(y,x) then go(i,x,j,y) else A.update(heap,i,x)
91 :     end
92 :     else
93 :     let val y = A.sub(heap,j)
94 :     val z = A.sub(heap,k)
95 :     in if less(y,x) then
96 :     if less(z,y) then go(i,x,k,z)
97 :     else go(i,x,j,y)
98 :     else if less(z,x) then go(i,x,k,z)
99 :     else A.update(heap,i,x)
100 :     end
101 :     end
102 :     and go(i,x,j,y) = (A.update(heap,i,y); siftdown(j,x))
103 :    
104 :     fun make_heap ~1 = ()
105 :     | make_heap i = (siftdown(i,A.sub(heap,i)); make_heap(i-1))
106 :    
107 :     val i = ref 0
108 :     val _ = #forall_nodes G (fn (u,_) =>
109 :     let val i' = !i in A.update(heap,i',u); i := i'+1 end)
110 :    
111 :     val _ = make_heap((N+1) div 2)
112 :    
113 :     val _ = A.appi (fn (i,x) => A.update(pos,x,i)) (heap,0,NONE)
114 :    
115 :     in Q{ less = less, heap = heap, pos = pos, size = ref N }
116 :     end
117 :     end

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