Here is a function of the sort one might submit to the Wolfram Function Repository, with the capability of supporting multiple “subfunctions”. The idea is to allow multiple “actions” that are common to a certain structure. The structure in question is simply a priority queue, also referred to as an ordered heap, wherein each node at position has zero, one, or two children (located at positions and , if those positions are occupied), and satisfies the property that it is larger, by some comparison function, than all its children.
j
2j
2j+1
A nice property of such queues is that if there are elements, then adding a new element is and removing the largest element is likewise . So they are good structures for e.g. sorting sets.
n
O(logn)
O(logn)
I want to allow the following operations:
◼
Create a queue
◼
Add an element to a queue
◼
Remove the largest (top) element
◼
Find the value of the largest element without removing it
◼
Check if the queue is empty
◼
Check the length of the queue
The operations are specified as strings, with several allowed to default based on argument structure. The strings are .
{"Enqueue","Dequeue","Peek","Initialize","Length","EmptyQ"}
Initialization in this case allows for three optional values, specified using rule syntax (with default values shown):. One can specify none, any, or all of these, with the defaults used for all unspecified initial values. Also one can pass initialization parameters and a list of values to be put into the queue. A queue object is returned, comprised of a list of four elements: the queued values (as a list), the position of the last element, the default initial value (used when the queue is created and also when it is necessary to enlarge it), and the comparison function.
{"InitialSize"16,"NullElement"->Missing["empty slot"],"ComparisonFunction"->Greater}
The actions of adding and removing elements are implemented in the Wolfram Language emulation of “call-by-value”, that is to say, the function PriorityQueue holds its first argument. This allows for modification “in place”, which is important for algorithmic complexity (in short, we avoid making copies of the data when we alter it).
I think this design is not manifestly awry, but otherwise make no claim as to it being the best possible. This implementation does not do careful error checking, and indeed does not do anything beyond basic structural tests of arguments to determine which action to take when none is specified. Also the implementation, while of the right complexity, is not terribly fast, at least in the realm of machine real numbers.
Implementation code
Implementation code
In[]:=
SetAttributes[PriorityQueue,HoldFirst];
In[]:=
defaultInits={16,Missing["empty slot"],Greater};defaultNames={"InitialSize","NullElement","ComparisonFunction"};defaultRule=Thread[defaultNamesdefaultInits];operations={"Enqueue","Dequeue","Peek","Initialize","Length","EmptyQ"};
In[]:=
PriorityQueue[]:=PriorityQueue[defaultRule,"Initialize"]PriorityQueue[inits_]/;Length[Evaluate[inits]]≤3:=PriorityQueue[inits,"Initialize"]PriorityQueue[inits_,vals_]/;Length[Evaluate[inits]]≤3&&ListQ[Evaluate[vals]]:=PriorityQueue[inits,vals,"Initialize"]PriorityQueue[heap_]/;Length[Evaluate[heap]]4:=PriorityQueue[heap,"Dequeue"]PriorityQueue[heap_,elem_]/;!MemberQ[operations,Evaluate@elem]:=PriorityQueue[heap,elem,"Enqueue"]
In[]:=
PriorityQueue[inits_,"Initialize"]:=With[{allinits=defaultNames/.inits/.defaultRule},{Developer`ToPackedArray[ConstantArray[allinits[[2]],allinits[[1]]]],0,allinits[[2]],allinits[[3]]}]
In[]:=
PriorityQueue[inits_,vals_,"Initialize"]:=Module[{heap=PriorityQueue[inits,"Initialize"]},Scan[PriorityQueue[heap,#,"Enqueue"]&,vals];heap]
In[]:=
PriorityQueue[heap_,elem_,"Enqueue"]/;MatchQ[Evaluate[heap],{elems_List,bottom_Integer,_,_}/;bottom≥0]:=Module[{elems,bottom=heap[[2]],newlist,comp=heap[[4]],mid},If[bottomLength[heap[[1]]],newlist=Join[heap[[1]],ConstantArray[heap[[3]],bottom]];heap={newlist,bottom,heap[[3]],heap[[4]]}];bottom++;heap[[2]]=bottom;heap[[1,bottom]]=elem;mid=Floor[bottom/2];While[mid≥1&&TrueQ[comp[heap[[1,bottom]],heap[[1,mid]]]],heap[[1,{mid,bottom}]]=heap[[1,{bottom,mid}]];{bottom,mid}=Floor[{bottom,mid}/2];];]
In[]:=
PriorityQueue[heap_,"Peek"]/;Length[Evaluate[heap]]4:=heap[[1,1]]
In[]:=
PriorityQueue[heap_,"Length"]/;Length[Evaluate[heap]]4:=heap[[2]]
In[]:=
PriorityQueue[heap_,"EmptyQ"]/;Length[Evaluate[heap]]4:=heap[[2]]0
In[]:=
PriorityQueue[heap_,"Dequeue"]/;MatchQ[Evaluate[heap],{elems_List,bottom_Integer,_,_}/;bottom≥1]:=Module[{first=heap[[1,1]],bottom=heap[[2]],comp=heap[[4]],prev,next,j1,j2,done=False},heap[[1,1]]=heap[[1,bottom]];heap[[1,bottom]]=heap[[3]];bottom--;heap[[2]]=bottom;prev=1;next=1;{j1,j2}=2*prev+{0,1};While[j1<=bottom&&!done,If[j2<=bottom,If[TrueQ[comp[heap[[1,j1]],heap[[1,j2]]]],next=j1,next=j2],next=j1];If[TrueQ[comp[heap[[1,next]],heap[[1,prev]]]],heap[[1,{prev,next}]]=heap[[1,{next,prev}]];prev=next;{j1,j2}=2*prev+{0,1};,done=True];];first]
Basic usage
Basic usage
All the allowed operations can be specified explicitly e.g. as . This is required for disambiguation in some cases; the ones where the operation can be inferred are shown below.
PriorityQueue[args,"Enqueue"]
PriorityQueue[]
PriorityQueue[inits]
PriorityQueue[inits,vals]
top=PriorityQueue[queue]
top
PriorityQueue[queue,val]
val
queue
Some examples and testing
Some examples and testing
Initialize a priority queue (aka ordered heap) with 40 random reals between -1 and 1:
In[]:=
heap=PriorityQueue[Thread[defaultNames{16,Missing[],Greater}],RandomReal[{-1,1},40]];
Check the size:
In[]:=
PriorityQueue[heap,"Length"]
Out[]=
40
Check the value of the largest element:
In[]:=
PriorityQueue[heap,"Peek"]
Out[]=
0.951727
Add 40 more random elements and recheck these values:
In[]:=
Map[PriorityQueue[heap,#]&,RandomReal[{-1,1},40]];PriorityQueue[heap,"Length"]PriorityQueue[heap,"Peek"]
Out[]=
80
Out[]=
0.951727
Empty the queue by dequeuing one-by-one. The result will be the queue elements sorted largest-to-smallest:
In[]:=
sorted=Reap[While[!PriorityQueue[heap,"EmptyQ"],Sow[PriorityQueue[heap,"Dequeue"]]]][[2,1]]
Out[]=
{0.951727,0.916126,0.890083,0.885162,0.836815,0.822791,0.81932,0.812215,0.740747,0.733825,0.624784,0.589561,0.589337,0.585367,0.553135,0.550583,0.549825,0.5356,0.525955,0.508708,0.467515,0.461063,0.447266,0.43266,0.424061,0.391959,0.386385,0.382999,0.364702,0.354373,0.343336,0.337408,0.309046,0.290303,0.287313,0.280119,0.27462,0.212562,0.187197,0.0943759,0.0843012,0.0680797,0.0646349,0.04529,0.0430743,0.024481,0.021305,0.000711269,-0.0238431,-0.0995927,-0.103869,-0.151432,-0.295136,-0.306433,-0.308633,-0.315594,-0.323516,-0.349411,-0.358928,-0.387848,-0.388248,-0.43583,-0.464091,-0.499178,-0.537707,-0.558251,-0.591237,-0.604605,-0.646478,-0.665944,-0.679127,-0.694964,-0.700116,-0.707578,-0.715518,-0.720469,-0.74681,-0.789325,-0.922807,-0.935424}
Check that it is indeed empty:
In[]:=
PriorityQueue[heap,"EmptyQ"]
Out[]=
True
And the length is now zero:
In[]:=
PriorityQueue[heap,"Length"]
Out[]=
0
Check that the complexity is not much worse than linear in the size.
In[]:=
size=10^4;vals=RandomReal[{-1,1},size];Timing[heap=PriorityQueue[Thread[defaultNames{10^3,0.,Greater}],vals];]
Out[]=
{0.256,Null}
In[]:=
Timing[sorted=Reap[While[!PriorityQueue[heap,"EmptyQ"],Sow[PriorityQueue[heap,"Dequeue"]]]][[2,1]];]
Out[]=
{0.956,Null}
Check that it is sorted largest to smallest:
Double the size and check that enqueing and dequeing take approximately twice as long.