Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

F# priority queue

Does the F# library include a priority queue? Else can someone point to me an implementation of priority queue in F#?

like image 834
Muhammad Alkarouri Avatar asked Jul 24 '10 19:07

Muhammad Alkarouri


3 Answers

Take a look at http://lepensemoi.free.fr/index.php/tag/data-structure for a whole bunch of F# implementations of various data structures.

like image 158
kvb Avatar answered Sep 20 '22 20:09

kvb


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.

like image 28
GordonBGood Avatar answered Sep 18 '22 20:09

GordonBGood


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

like image 22
Jack Fox Avatar answered Sep 18 '22 20:09

Jack Fox