# Efficient priority queues?

I'm trying to figure out how to transfer the concept of a priority queue to the functional world. Searches have turned up some implementations that use Append and other expense list copying techniques. I'm guessing there is a better way.

An example of what I am trying to solve is consider the products of all pairs of N digit numbers in descending value order. For small N I can do something like...

Reverse[
Cases[
SortBy[
Flatten[
Table[{i, j, i*j}, {i, 1, 9}, {j, 1, 9}],
1],
Last[#] &],
{i_, j_, k_} /; i <= j]
]


Alternative solutions to the problem in particular are welcomed, but I am really looking for a generic answer of how to apply the priority queue concept to the functional world.

• I'll admit I'm not really familiar with priority queues. What operations do you wish to perform on this data structure? Sep 9, 2013 at 12:34
• @Mr.Wizard: simply enqueue (put some value) and dequeue (take the smallest value). Namely it is used to always get the smallest (or largest) value in O(1) time and insertions usually take O(lg(N)) time. Traditional implementations use a heaps to achieve this. Sep 9, 2013 at 12:42
• I have found an old implementation by Roman E. Maeder. The code can probably be made faster in current versions of Mathematica but the underlying algorithm is likely well thought out. Sep 9, 2013 at 13:04
• As a small suggestion, you shall use FactorInteger to generate factors and refer mathematica.stackexchange.com/questions/30683/… to see how you can get your desired results. How you will use it for priority queue, I don't know but in case its important for you. Sep 9, 2013 at 13:11
• By the way, for the problem at hand, one could simply do a Sort on the list of values. Point being, if you are going to work on the set all at once, a queue will likely slow you as compared to a sorting (even though that sorting might be implemented via priority queue-- it will be at a lower level using more optimized code). Sep 9, 2013 at 15:31

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;
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[]

DeQueue[queue[ar_,n_,pred_]] :=
Module[{i,j,res=ar[]},
ar[] = 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[]

• This seems to fail when adding a second value; q = MakeQueue[]; EnQueue[q, 5]; EnQueue[q, 10]; The second EnQueue fails with "Part::partd: "Part specification PriorityQueuePrivatex[[{1,2}]] is longer than depth of object" and "Set::noval: Symbol PriorityQueuePrivatex in part assignment does not have an immediate value." Sep 9, 2013 at 15:16
• @Andrew Thanks! There's the first bug I introduced I guess. Disconcertingly I thought I tested this before posting. Sep 9, 2013 at 15:25
• @Andrew Please try it now. Sep 9, 2013 at 15:32
• Version 0.2 seems to be working. Not the speedest thing in the world though. I've +1ed and I'll leave this open for another day to encourage alternative solutions. Thanks for the insight. Sep 9, 2013 at 22:36
• @Andrew You in no way need to Accept this answer. There may very well be a completely different and superior approach that is empowered by functionality added since version 3 (for which I believe this was written). For example with the new LibraryLink it may be possible to do this externally and still have reasonable communication overhead. Sep 9, 2013 at 22:41

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["ParallelQueuePriority"]
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

ParallelQueueFIFOFIFOQueue[]


and stack in

ParallelQueueLIFOLIFOQueue[]

• How did you find this? Sep 24, 2013 at 17:43
• @AndrewWhite, was browsing through mathematica files and found a suspiciously looking Queue folder in AddOns\Applications\Parallel (and I just needed a FIFO queue for my task), and inside was the whole works: FIFO, LIFO, Priority, even a Lisp queue which I have no idea what is for. Sep 24, 2013 at 18:06
• @panda-34, Is It a indexed priority queue? How should I use the priorityqueue beyond the simple example. Suppose I want to turn this list {{0.1, {a}}, {0.6, {b}}, {0.5, {c}}, {2.3, {d}}} into a priorityqueue. The smaller first value has high priority, for example {0.1, {1}} has priority over {0.6, {b}}. Dec 20, 2013 at 8:39
• @novice, use global Priority[element] function as in my example. In you case it may be like: Priority[i_List] := -i[]; Dec 28, 2013 at 9:57
• @panda-34, can I somehow increase the value of an element in the queue? For example I have a min-first queue, just like in novice's case: {{-5, 3}, {0.5, 8}, {1, 3}, {5, 5}} and I want to decrease the 3rd elements value to {0, 3} and get {{-5, 3}, {0, 3}, {0.5, 8}, {5, 5}} One should be able to do this very fast only by changing parents and children in the tree.
– user40302
May 17, 2016 at 8:04

As of Mathematica 12.1, you can use CreateDataStructure to, well, create data structures, and priority queues are one of them.

SeedRandom;
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} *)

• How is the performance of this? Mar 18, 2020 at 23:29
• It filled and emptied 10000 elements in just over 50 milliseconds on my computer. ReverseSort took 1 millisecond to get the same result, FWIW, but that seems like a dubious comparison. Mar 18, 2020 at 23:33