Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/MLRISC/graphs/node-priqueue.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/MLRISC/graphs/node-priqueue.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 410, Fri Sep 3 00:25:03 1999 UTC revision 411, Fri Sep 3 00:25:03 1999 UTC
# Line 1  Line 1 
1  signature NODE_PRIORITY_QUEUE =  (*
2  sig   * This implements a priority queue for nodes in a graph
3     *
4     type node_priority_queue   * -- Allen
5     *)
    exception EmptyPriorityQueue  
   
    val create         : (Graph.node_id * Graph.node_id -> bool) ->  
                            node_priority_queue  
    val fromGraph      : (Graph.node_id * Graph.node_id -> bool) ->  
                           ('n,'e,'g) Graph.graph -> node_priority_queue  
    val isEmpty        : node_priority_queue -> bool  
    val clear          : node_priority_queue -> unit  
    val min            : node_priority_queue -> Graph.node_id  
    val deleteMin      : node_priority_queue -> Graph.node_id  
    val decreaseWeight : node_priority_queue * Graph.node_id -> unit  
    val insert         : node_priority_queue * Graph.node_id -> unit  
    val toList         : node_priority_queue -> Graph.node_id list  
 end  
6    
7  functor NodePriorityQueueFn(A : ARRAY_SIG) : NODE_PRIORITY_QUEUE =  functor NodePriorityQueueFn(A : ARRAY) : NODE_PRIORITY_QUEUE =
8  struct  struct
9     structure G = Graph     structure G = Graph
10    
11     exception EmptyPriorityQueue     exception EmptyPriorityQueue
12    
13     datatype node_priority_queue =     datatype node_priority_queue =
14         Q of { <    : G.node_id * G.node_id -> bool,         Q of { less : G.node_id * G.node_id -> bool,
15                heap : G.node_id A.array,                heap : G.node_id A.array,
16                pos  : int A.array,                pos  : int A.array,
17                size : int ref                size : int ref
18              }              }
19     fun create less = Q { <    = less,     fun create N less = Q { less = less,
20                           heap = A.array(13,0),                             heap = A.array(N,0),
21                           pos  = A.array(13,0),                             pos  = A.array(N,0),
22                           size = ref 0                           size = ref 0
23                         }                         }
24    
# Line 44  Line 30 
30     fun min   (Q { size = ref 0, ... }) = raise EmptyPriorityQueue     fun min   (Q { size = ref 0, ... }) = raise EmptyPriorityQueue
31       | min   (Q { heap, ... }) = A.sub(heap, 0)       | min   (Q { heap, ... }) = A.sub(heap, 0)
32    
33     fun decreaseWeight(Q { size, heap, pos, <}, x) =     fun decreaseWeight(Q{ size, heap, pos, less }, x) =
34     let fun siftup 0 = 0     let fun siftup 0 = 0
35           | siftup i =           | siftup i =
36             let val j = (i-1) div 2             let val j = (i-1) div 2
37                 val y = A.sub(heap,j)                 val y = A.sub(heap,j)
38             in  if x < y then (A.update(heap,i,y); A.update(pos,y,i); siftup j)         in  if less(x,y) then (A.update(heap,i,y); A.update(pos,y,i); siftup j)
39                 else i                 else i
40             end             end
41         val x_pos = siftup(A.sub(pos,x))         val x_pos = siftup(A.sub(pos,x))
42     in     in  A.update(heap,x_pos,x); A.update(pos,x,x_pos)
        A.update(heap,x_pos,x); A.update(pos,x,x_pos)  
43     end     end
44    
45     fun insert(Q { size, heap, pos, < }, x) =     fun insert(q as Q{ size, heap, pos, ...}, x) =
46     let val N = !size     let val N = !size
47         fun siftup 0 = 0     in  A.update(heap,N,x); A.update(pos,x,N); size := N + 1;
48           | siftup i =         decreaseWeight(q,x)
            let val j = (i-1) div 2  
                val y = A.sub(heap,j)  
            in  if x < y then (A.update(heap,i,y); A.update(pos,y,i); siftup j)  
                else i  
            end  
        val x_pos = siftup N  
    in  
        A.update(heap,x_pos,x); A.update(pos,x,x_pos);  
        size := N + 1  
49     end     end
50    
51     fun deleteMin(Q { size = ref 0, heap, pos, <}) = raise EmptyPriorityQueue     fun deleteMin(Q{ size = ref 0, ...}) = raise EmptyPriorityQueue
52       | deleteMin(Q { size, heap, pos, <}) =       | deleteMin(Q{ size, heap, pos, less}) =
53     let val N = !size - 1     let val N = !size - 1
54         fun siftdown (i,x) =         fun siftdown (i,x) =
55         let val j = i*2 + 1         let val j = i + i + 1
56             val k = j + 1             val k = j + 1
57         in  if j >= N then i         in  if j >= N then i
58             else if k >= N then             else let val y = A.sub(heap,j)
59                let val y = A.sub(heap,j)                  in  if k >= N then
60                in  if y < x then go(i,x,j,y) else i                         if less(y,x) then go(i,x,j,y) else i
               end  
61             else             else
62                let val y = A.sub(heap,j)                         let val z = A.sub(heap,k)
63                    val z = A.sub(heap,k)                         in  if less(y,x) then
64                in  if y < x andalso not(z < y) then go(i,x,j,y)                                if less(z,y) then go(i,x,k,z)
65                    else if z < x andalso not(y < z) then go(i,x,k,z)                                else go(i,x,j,y)
66                               else if less(z,x) then go(i,x,k,z)
67                    else i                    else i
68                end                end
69         end         end
70           end
71         and go(i,x,j,y) = (A.update(heap,i,y); A.update(pos,y,i); siftdown(j,x))         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)         val min   = A.sub(heap,0)
73         val x     = A.sub(heap,N)         val x     = A.sub(heap,N)
74         val x_pos = siftdown(0, x)         val x_pos = siftdown(0, x)
75     in  A.update(heap,x_pos,x); A.update(heap,x,x_pos);     in  A.update(heap,x_pos,x); A.update(pos,x,x_pos);
76         size := N;         size := N;
77         min         min
78     end     end
79    
80     fun toList (Q { heap, size, ... }) =     fun fromGraph less (G.GRAPH G) =
        A.foldli (fn (i,x,l) => x::l) [] (heap,0,SOME(!size-1))  
   
    fun fromGraph op< (G.GRAPH G) =  
81     let val N    = #order G ()     let val N    = #order G ()
82         val heap = A.array(N,0)         val heap = A.array(N,0)
83         val pos  = A.array(N,0)         val pos  = A.array(#capacity G (),0)
84         fun siftdown (i,x) =         fun siftdown (i,x) =
85         let val j = i*2 + 1         let val j = i*2 + 1
86             val k = j + 1             val k = j + 1
87         in  if j >= N then A.update(heap,i,x)         in  if j >= N then A.update(heap,i,x)
88             else if k >= N then             else if k >= N then
89                let val y = A.sub(heap,j)                let val y = A.sub(heap,j)
90                in  if y < x then go(i,x,j,y) else A.update(heap,i,x)                in  if less(y,x) then go(i,x,j,y) else A.update(heap,i,x)
91                end                end
92             else             else
93                let val y = A.sub(heap,j)                let val y = A.sub(heap,j)
94                    val z = A.sub(heap,k)                    val z = A.sub(heap,k)
95                in  if y < x andalso not(z < y) then go(i,x,j,y)                in  if less(y,x) then
96                    else if z < x andalso not(y < z) then go(i,x,k,z)                       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)                    else A.update(heap,i,x)
100                end                end
101         end         end
# Line 128  Line 104 
104         fun make_heap ~1 = ()         fun make_heap ~1 = ()
105           | make_heap i = (siftdown(i,A.sub(heap,i)); make_heap(i-1))           | make_heap i = (siftdown(i,A.sub(heap,i)); make_heap(i-1))
106    
107         val _ = make_heap(N div 2)         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)         val _ = A.appi (fn (i,x) => A.update(pos,x,i)) (heap,0,NONE)
114    
115     in  Q { < = op <, heap = heap, pos = pos, size = ref N }     in  Q{ less = less, heap = heap, pos = pos, size = ref N }
116     end     end
117  end  end
   
 (*  
  * $Log$  
  *)  

Legend:
Removed from v.410  
changed lines
  Added in v.411

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