Efficient priority queues?

Question

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.

Answer 1

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

Answer 2

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

Answer 3

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