Efficient priority queues?
Actually, Mathematica has this stuff built in. I couldn't find this information anywhere, so posting it here for general reference. You can use it like this:
Needs["Parallel`Queue`Priority`"]
Unprotect@Priority; Priority[i_Integer] := Abs[i]
q = priorityQueue[];
EnQueue[q, 10]; EnQueue[q, 7]; EnQueue[q, -20];
Size[q] == 3;
Top[q] == -20;
Normal[q] == {-20, 10, 7}
DeQueue[q] == -20;
There is also a simple FIFO queue in
Parallel`Queue`FIFO`FIFOQueue[]
and stack in
Parallel`Queue`LIFO`LIFOQueue[]
This is going to be transcript of Roman E. Maeder's priority queue code with any updates I can find to make to take advantage of functions added since he wrote it.
I believe I am within right to copy it here for noncommercial purposes.
Refactor v0.2 -- any bugs are almost certainly my own.
BeginPackage["PriorityQueue`"]
MakeQueue::usage = "MakeQueue[pred] creates an empty priority queue with
the given ording predicate. The default predicate is Greater."
CopyQueue::usage = "CopyQueue[q] makes a copy of the priority queue q."
DeleteQueue::usage = "DeleteQueue[q] frees the storage used for q."
EmptyQueue::usage = "EmptyQueue[q] is True if the priority queue q is empty."
EnQueue::usage = "EnQueue[a, item] inserts item into the priority queue q."
TopQueue::usage = "TopQueue[q] returns the largest item in the priority queue q."
DeQueue::usage = "DeQueue[q] removes the largest item from the priority queue q.
It returns the item removed."
PriorityQueue::usage = "PriorityQueue[...] is the print form of priority queues."
Begin["`Private`"]
SetAttributes[queue, HoldAll]
SetAttributes[array, HoldAllComplete]
makeArray[n_] := array @@ ConstantArray[Null, n]
MakeQueue[pred_:Greater] :=
Module[{ar,n=0},
ar = makeArray[2];
queue[ar, n, pred]
]
CopyQueue[queue[a0_,n0_,pred_]] :=
Module[{ar=a0,n=n0},
queue[ar, n, pred]
]
EnQueue[q:queue[ar_,n_,pred_], val_] :=
Module[{i,j},
If[ n == Length[ar], (* extend (double size) *)
ar = Join[ar, makeArray @ Length @ ar] ];
n++;
ar[[n]] = val; i = n;
While[ True, (* restore heap *)
j = Quotient[i, 2];
If[ j < 1 || pred[ar[[j]], ar[[i]]], Break[] ];
ar[[{i,j}]] = {ar[[j]], ar[[i]]};
i = j;
];
q
]
EmptyQueue[queue[ar_,n_,pred_]] := n == 0
TopQueue[queue[ar_,n_,pred_]] := ar[[1]]
DeQueue[queue[ar_,n_,pred_]] :=
Module[{i,j,res=ar[[1]]},
ar[[1]] = ar[[n]]; ar[[n]] = Null; n--;
j = 1;
While[ j <= Quotient[n, 2], (* restore heap *)
i = 2j;
If[ i < n && pred[ar[[i+1]], ar[[i]]], i++ ];
If[ pred[ar[[i]], ar[[j]]],
ar[[{i,j}]] = {ar[[j]], ar[[i]]}; ];
j = i
];
res
]
DeleteQueue[queue[ar_,n_,pred_]] := (ClearAll[ar,n];)
queue/:Normal[q0_queue] :=
Module[{q=CopyQueue[q0]},
Reap[While[!EmptyQueue[q], Sow @ DeQueue[q]]; DeleteQueue[q];][[2,1]]
]
Format[q_queue/;EmptyQueue[q]] := PriorityQueue[]
Format[q_queue] := PriorityQueue[TopQueue[q], "\[TripleDot]"]
End[]
EndPackage[]
As of Mathematica 12.1, you can use CreateDataStructure
to, well, create data structures, and priority queues are one of them.
SeedRandom[1337];
stuff = RandomInteger[100, 10]
(* {58, 91, 36, 72, 63, 16, 60, 13, 44, 18} *)
pq = CreateDataStructure["PriorityQueue"]
(* DataStructure["PriorityQueue", {"Data" -> {}}] *)
Scan[pq["Push", #]&, stuff];
(* This neat trick comes right from the doc page! *)
Table[pq["Pop"], {pq["Length"]}]
(* {91, 72, 63, 60, 58, 44, 36, 18, 16, 13} *)