Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
    
I'll admit I'm not really familiar with priority queues. What operations do you wish to perform on this data structure? –  Mr.Wizard Sep 9 '13 at 12:34
1  
@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. –  Andrew White Sep 9 '13 at 12:42
2  
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. –  Mr.Wizard Sep 9 '13 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. –  Rorschach Sep 9 '13 at 13:11
1  
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). –  Daniel Lichtblau Sep 9 '13 at 15:31
show 7 more comments

2 Answers

up vote 12 down vote accepted

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[]
share|improve this answer
    
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 PriorityQueue`Private`x[[{1,2}]] is longer than depth of object" and "Set::noval: Symbol PriorityQueue`Private`x in part assignment does not have an immediate value." –  Andrew White Sep 9 '13 at 15:16
    
@Andrew Thanks! There's the first bug I introduced I guess. Disconcertingly I thought I tested this before posting. –  Mr.Wizard Sep 9 '13 at 15:25
    
@Andrew Please try it now. –  Mr.Wizard Sep 9 '13 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. –  Andrew White Sep 9 '13 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. –  Mr.Wizard Sep 9 '13 at 22:41
add comment

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[]
share|improve this answer
    
How did you find this? –  Andrew White Sep 24 '13 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. –  panda-34 Sep 24 '13 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}}. –  novice Dec 20 '13 at 8:39
    
@novice, use global Priority[element] function as in my example. In you case it may be like: Priority[i_List] := -i[[1]]; –  panda-34 Dec 28 '13 at 9:57
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.