Does the F# library include a priority queue? Else can someone point to me an implementation of priority queue in F#?
Take a look at http://lepensemoi.free.fr/index.php/tag/data-structure for a whole bunch of F# implementations of various data structures.
It is amazing that the accepted answer still almost works with all the changes to F# over the intervening over seven years with the exception that there no longer is a Pervasives.compare function and the "compare" function has now been merged into the base operators at Microsoft.FSharp.Core.Operators.compare.
That said, that referenced blog entry implements the Binomial Heap as a general purpose Heap and not as for the specific requirements of a Priority Queue as to not requiring a generic type for the priority which can just be an integer type for efficiency in comparisons, and it speaks of but does not implement the additional improvement to preserve the minimum as a separate field for efficiency in just checking the top priority item in the queue.
The following module code implements the Binomial Heap Priority Queue as derived from that code with the improved efficiency that it does not use generic comparisons for the priority comparisons and the more efficient O(1) method for checking the top of the queue (although at the cost of more overhead for inserting and deleting entries although they are still O(log n) - n being the number of entries in the queue). This code is more suitable for the usual application of priority queues where the top of the queue is read more often than insertions and/or top item deletions are performed. Note that it isn't as efficient as the MinHeap when one is deleting the top element and reinserting it further down the queue as a full "deleteMin" and "insert" must be performed with much more of a computational overhead. The code is as follows:
[<RequireQualifiedAccess>]
module BinomialHeapPQ =
// type 'a treeElement = Element of uint32 * 'a
type 'a treeElement = class val k:uint32 val v:'a new(k,v) = { k=k;v=v } end
type 'a tree = Node of uint32 * 'a treeElement * 'a tree list
type 'a heap = 'a tree list
type 'a outerheap = | HeapEmpty | HeapNotEmpty of 'a treeElement * 'a heap
let empty = HeapEmpty
let isEmpty = function | HeapEmpty -> true | _ -> false
let inline private rank (Node(r,_,_)) = r
let inline private root (Node(_,x,_)) = x
exception Empty_Heap
let getMin = function | HeapEmpty -> None
| HeapNotEmpty(min,_) -> Some min
let rec private findMin heap =
match heap with | [] -> raise Empty_Heap //guarded so should never happen
| [node] -> root node,[]
| topnode::heap' ->
let min,subheap = findMin heap' in let rtn = root topnode
match subheap with
| [] -> if rtn.k > min.k then min,[] else rtn,[]
| minnode::heap'' ->
let rmn = root minnode
if rtn.k <= rmn.k then rtn,heap
else rmn,minnode::topnode::heap''
let private mergeTree (Node(r,kv1,ts1) as tree1) (Node (_,kv2,ts2) as tree2) =
if kv1.k > kv2.k then Node(r+1u,kv2,tree1::ts2)
else Node(r+1u,kv1,tree2::ts1)
let rec private insTree (newnode: 'a tree) heap =
match heap with
| [] -> [newnode]
| topnode::heap' -> if (rank newnode) < (rank topnode) then newnode::heap
else insTree (mergeTree newnode topnode) heap'
let insert k v = let kv = treeElement(k,v) in let nn = Node(0u,kv,[])
function | HeapEmpty -> HeapNotEmpty(kv,[nn])
| HeapNotEmpty(min,heap) -> let nmin = if k > min.k then min else kv
HeapNotEmpty(nmin,insTree nn heap)
let rec private merge' heap1 heap2 = //doesn't guaranty minimum tree node as head!!!
match heap1,heap2 with
| _,[] -> heap1
| [],_ -> heap2
| topheap1::heap1',topheap2::heap2' ->
match compare (rank topheap1) (rank topheap2) with
| -1 -> topheap1::merge' heap1' heap2
| 1 -> topheap2::merge' heap1 heap2'
| _ -> insTree (mergeTree topheap1 topheap2) (merge' heap1' heap2')
let merge oheap1 oheap2 = match oheap1,oheap2 with
| _,HeapEmpty -> oheap1
| HeapEmpty,_ -> oheap2
| HeapNotEmpty(min1,heap1),HeapNotEmpty(min2,heap2) ->
let min = if min1.k > min2.k then min2 else min1
HeapNotEmpty(min,merge' heap1 heap2)
let rec private removeMinTree = function
| [] -> raise Empty_Heap // will never happen as already guarded
| [node] -> node,[]
| t::ts -> let t',ts' = removeMinTree ts
if (root t).k <= (root t').k then t,ts else t',t::ts'
let deleteMin =
function | HeapEmpty -> HeapEmpty
| HeapNotEmpty(_,heap) ->
match heap with
| [] -> HeapEmpty // should never occur: non empty heap with no elements
| [Node(_,_,heap')] -> match heap' with
| [] -> HeapEmpty
| _ -> let min,_ = findMin heap'
HeapNotEmpty(min,heap')
| _::_ -> let Node(_,_,ts1),ts2 = removeMinTree heap
let nheap = merge' (List.rev ts1) ts2 in let min,_ = findMin nheap
HeapNotEmpty(min,nheap)
let reinsertMinAs k v pq = insert k v (deleteMin pq)
Note that there are two options in the form of the type "treeElement" in order to suit the way this is tested. In the application as noted in my answer about using priority queues to sieve primes, the above code is about 80% slower than the functional implementation of the MinHeap (non multi-processing mode, as the above binomial heap does not lend itself well to in-place adjustments); this is because of the additional computational complexity of the "delete followed by insert" operation for the Binomial Heap rather than the ability to combine these operations efficiently for the MinHeap implementation.
Thus, the MinHeap Priority Queue is more suitable for this type of application and also where efficient in-place adjustments are required, whereas the Binomial Heap Priority Queue is more suitable where one requires the ability to efficiently merge two queues into one.
FSharpx.Collections includes a functional Heap collection https://github.com/fsharp/fsharpx/blob/master/src/FSharpx.Core/Collections/Heap.fsi as well as a PriortityQueue interface for it https://github.com/fsharp/fsharpx/blob/master/src/FSharpx.Core/Collections/PriorityQueue.fs
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With