programming - 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.

Answer

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