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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/graphs/node-priqueue.sml

1 : monnier 245 signature NODE_PRIORITY_QUEUE =
2 :     sig
3 :    
4 :     type node_priority_queue
5 :    
6 :     exception EmptyPriorityQueue
7 :    
8 :     val create : (Graph.node_id * Graph.node_id -> bool) ->
9 :     node_priority_queue
10 :     val fromGraph : (Graph.node_id * Graph.node_id -> bool) ->
11 :     ('n,'e,'g) Graph.graph -> node_priority_queue
12 :     val isEmpty : node_priority_queue -> bool
13 :     val clear : node_priority_queue -> unit
14 :     val min : node_priority_queue -> Graph.node_id
15 :     val deleteMin : node_priority_queue -> Graph.node_id
16 :     val decreaseWeight : node_priority_queue * Graph.node_id -> unit
17 :     val insert : node_priority_queue * Graph.node_id -> unit
18 :     val toList : node_priority_queue -> Graph.node_id list
19 :     end
20 :    
21 :     functor NodePriorityQueueFn(A : ARRAY_SIG) : NODE_PRIORITY_QUEUE =
22 :     struct
23 :     structure G = Graph
24 :    
25 :     exception EmptyPriorityQueue
26 :    
27 :     datatype node_priority_queue =
28 :     Q of { < : G.node_id * G.node_id -> bool,
29 :     heap : G.node_id A.array,
30 :     pos : int A.array,
31 :     size : int ref
32 :     }
33 :     fun create less = Q { < = less,
34 :     heap = A.array(13,0),
35 :     pos = A.array(13,0),
36 :     size = ref 0
37 :     }
38 :    
39 :     fun isEmpty (Q { size = ref 0, ... }) = true
40 :     | isEmpty _ = false
41 :    
42 :     fun clear (Q { size, ... }) = size := 0
43 :    
44 :     fun min (Q { size = ref 0, ... }) = raise EmptyPriorityQueue
45 :     | min (Q { heap, ... }) = A.sub(heap, 0)
46 :    
47 :     fun decreaseWeight(Q { size, heap, pos, <}, x) =
48 :     let fun siftup 0 = 0
49 :     | siftup i =
50 :     let val j = (i-1) div 2
51 :     val y = A.sub(heap,j)
52 :     in if x < y then (A.update(heap,i,y); A.update(pos,y,i); siftup j)
53 :     else i
54 :     end
55 :     val x_pos = siftup(A.sub(pos,x))
56 :     in
57 :     A.update(heap,x_pos,x); A.update(pos,x,x_pos)
58 :     end
59 :    
60 :     fun insert(Q { size, heap, pos, < }, x) =
61 :     let val N = !size
62 :     fun siftup 0 = 0
63 :     | siftup i =
64 :     let val j = (i-1) div 2
65 :     val y = A.sub(heap,j)
66 :     in if x < y then (A.update(heap,i,y); A.update(pos,y,i); siftup j)
67 :     else i
68 :     end
69 :     val x_pos = siftup N
70 :     in
71 :     A.update(heap,x_pos,x); A.update(pos,x,x_pos);
72 :     size := N + 1
73 :     end
74 :    
75 :     fun deleteMin(Q { size = ref 0, heap, pos, <}) = raise EmptyPriorityQueue
76 :     | deleteMin(Q { size, heap, pos, <}) =
77 :     let val N = !size - 1
78 :     fun siftdown (i,x) =
79 :     let val j = i*2 + 1
80 :     val k = j + 1
81 :     in if j >= N then i
82 :     else if k >= N then
83 :     let val y = A.sub(heap,j)
84 :     in if y < x then go(i,x,j,y) else i
85 :     end
86 :     else
87 :     let val y = A.sub(heap,j)
88 :     val z = A.sub(heap,k)
89 :     in if y < x andalso not(z < y) then go(i,x,j,y)
90 :     else if z < x andalso not(y < z) then go(i,x,k,z)
91 :     else i
92 :     end
93 :     end
94 :     and go(i,x,j,y) = (A.update(heap,i,y); A.update(pos,y,i); siftdown(j,x))
95 :     val min = A.sub(heap,0)
96 :     val x = A.sub(heap,N)
97 :     val x_pos = siftdown(0, x)
98 :     in A.update(heap,x_pos,x); A.update(heap,x,x_pos);
99 :     size := N;
100 :     min
101 :     end
102 :    
103 :     fun toList (Q { heap, size, ... }) =
104 :     A.foldli (fn (i,x,l) => x::l) [] (heap,0,SOME(!size-1))
105 :    
106 :     fun fromGraph op< (G.GRAPH G) =
107 :     let val N = #order G ()
108 :     val heap = A.array(N,0)
109 :     val pos = A.array(N,0)
110 :     fun siftdown (i,x) =
111 :     let val j = i*2 + 1
112 :     val k = j + 1
113 :     in if j >= N then A.update(heap,i,x)
114 :     else if k >= N then
115 :     let val y = A.sub(heap,j)
116 :     in if y < x then go(i,x,j,y) else A.update(heap,i,x)
117 :     end
118 :     else
119 :     let val y = A.sub(heap,j)
120 :     val z = A.sub(heap,k)
121 :     in if y < x andalso not(z < y) then go(i,x,j,y)
122 :     else if z < x andalso not(y < z) then go(i,x,k,z)
123 :     else A.update(heap,i,x)
124 :     end
125 :     end
126 :     and go(i,x,j,y) = (A.update(heap,i,y); siftdown(j,x))
127 :    
128 :     fun make_heap ~1 = ()
129 :     | make_heap i = (siftdown(i,A.sub(heap,i)); make_heap(i-1))
130 :    
131 :     val _ = make_heap(N div 2)
132 :    
133 :     val _ = A.appi (fn (i,x) => A.update(pos,x,i)) (heap,0,NONE)
134 :    
135 :     in Q { < = op <, heap = heap, pos = pos, size = ref N }
136 :     end
137 :     end
138 :    
139 :     (*
140 :     * $Log$
141 :     *)

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