F＃優先級隊列

Question

F＃庫是否包含優先級隊列？ 有人可以指點我在F＃中實現優先級隊列嗎？

Answer 1

查看http://lepensemoi.free.fr/index.php/tag/data-structure ，了解各種數據結構的F＃實現。

Answer 2

FSharpx.Collections包括一個功能性的Heap集合https://github.com/fsharp/fsharpx/blob/master/src/FSharpx.Core/Collections/Heap.fsi以及它的PriortityQueue接口https://github.com /fsharp/fsharpx/blob/master/src/FSharpx.Core/Collections/PriorityQueue.fs

Answer 3

令人驚訝的是，除了不再有Pervasives.compare函數和“比較”函數現已合並到基礎運算符之外，接受的答案仍然幾乎與F＃的所有變化一起工作七年以上。 Microsoft.FSharp.Core.Operators.compare。

也就是說，引用的博客條目將二項式堆實現為通用堆，而不是優先級隊列的特定要求，而不需要優先級的泛型類型，這可以只是整數類型的比較效率，以及它說的但沒有實現額外的改進，只保留最小值作為單獨的字段來提高效率，只需檢查隊列中的最高優先級項目。

以下模塊代碼實現了從該代碼派生的二項式堆優先級隊列，其效率提高了，它不使用通用比較進行優先級比較，也使用更有效的O（1）方法來檢查隊列頂部（盡管在插入和刪除條目的開銷成本較高，盡管它們仍然是O（log n） - n是隊列中的條目數）。 此代碼更適合優先級隊列的常規應用，其中隊列的頂部比插入和/或頂級項刪除更頻繁地被讀取。 請注意，當刪除頂部元素並將其重新插入隊列中時，它不如MinHeap有效，因為完整的“deleteMin”和“插入”必須以更多的計算開銷執行。 代碼如下：

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

請注意，“treeElement”類型有兩種選項，以適應測試方式。 在我關於使用優先級隊列篩選素數的答案中提到的應用程序中，上面的代碼比MinHeap的功能實現慢了大約80％（非多處理模式，因為上面的二項式堆不適合於 - 場地調整）; 這是因為二項式堆的“刪除后插入”操作的額外計算復雜性，而不是為MinHeap實現有效地組合這些操作的能力。

因此，MinHeap優先級隊列更適合這種類型的應用程序，並且還需要有效的就地調整，而二項式堆優先級隊列更適合需要能夠有效地將兩個隊列合並為一個的情況。

Answer 4

EDITED：糾正純函數版本的deleteMin函數中的錯誤並添加ofSeq函數。

我在關於F＃prime sieves的答案中實現了兩個版本的基於MinHeap二進制堆的優先級隊列，第一個是純功能代碼（較慢），第二個是基於數組（ResizeArray，它建立在內部使用的DotNet列表上）用於存儲列表的數組）。 非功能版本有點合理，因為MinHeap通常在Michael Eytzinger 400多年前發明的基於系譜樹的模型之后被實現為可變數組二進制堆。

在那個答案中，我沒有實現“從隊列中刪除最高優先級項”功能，因為算法不需要它，但我確實實現了“重新插入隊列中的頂級項目”功能，因為算法確實需要它，並且函數非常類似於“deleteMin”函數所需的函數; 不同之處在於，不是使用新參數重新插入頂部“最小”項目，而是從隊列中刪除最后一項（以與插入新項目時相似的方式找到但更簡單），並重新插入該項目以替換頂部隊列中的（最小）項（只需調用“reinsertMinAt”函數）。 我還實現了一個“調整”功能，它將一個函數應用於所有隊列元素，然后重新將最終結果重新定義為效率，該函數是該答案中分頁的Eratosthenes算法篩選的要求。

在下面的代碼中，我實現了上面描述的“deleteMin”函數以及“ofSeq”函數，該函數可用於從使用內部“reheapify”函數的優先級/內容元組對元素序列構建新隊列為了效率。

通過在與優先級'k'值相關的比較中將大於符號更改為小於符號，反之亦然，可以很容易地將根據此代碼的MinHeap更改為“MaxHeap”。 Min / Max Heap支持相同無符號整數“Key”優先級的多個元素，但不保留具有相同優先級的條目的順序; 換句話說，沒有保證進入隊列的第一個元素將是彈出到最小位置的第一個元素，如果有其他條目具有與我不需要的相同的優先級並且當前代碼更有效。 如果需要，可以修改代碼以保留訂單（繼續將新插入向下移動直到過去任何具有相同優先級的條目）。

最小/最大堆優先級隊列的優點是，與其他類型的非簡單隊列相比，它具有較少的計算復雜性開銷，在O（1）時間內產生Min或Max（取決於MinHeap或MaxHeap實現），並且在最壞情況下插入和刪除O（log n）時間，而調整和構建僅需要O（n）時間，其中'n'是當前在隊列中的元素數。 “resinsertMinAs”函數優先於刪除然后插入的優點是它將最壞情況下的時間減少到O（log n）兩倍，並且通常比重新插入通常靠近隊列的開頭更好。不需要全掃描。

與二項式堆相比，使用指向最小值的指針的附加選項來產生O（1）找到最小值性能，MinHeap可能稍微簡單，因此在執行相同的工作時更快，特別是如果不需要二項式堆提供的“合並堆”功能。 與使用MinHeap相比，使用二項式堆“合並”函數“重新插入MinAs”可能需要更長時間，因為通常需要進行平均稍微更多的比較。

MinHeap優先級隊列特別適用於Eratosthenes的增量篩選問題，就像在另一個相關答案中一樣，並且可能是Melissa E. O'Neill 在她的論文中所做的工作中使用的隊列，顯示Turner prime篩子是對於算法和性能來說，不是Eratosthenes的篩子。

以下純函數代碼將“deleteMin”和“ofSeq”函數添加到該代碼：

[<RequireQualifiedAccess>]
module MinHeap =

  type MinHeapTreeEntry<'T> = class val k:uint32 val v:'T new(k,v) = { k=k;v=v } end
  [<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
  [<NoEquality; NoComparison>]
  type MinHeapTree<'T> = 
      | HeapEmpty 
      | HeapOne of MinHeapTreeEntry<'T>
      | HeapNode of MinHeapTreeEntry<'T> * MinHeapTree<'T> * MinHeapTree<'T> * uint32

  let empty = HeapEmpty

  let getMin pq = match pq with | HeapOne(kv) | HeapNode(kv,_,_,_) -> Some kv | _ -> None

  let insert k v pq =
    let kv = MinHeapTreeEntry(k,v)
    let rec insert' kv msk pq =
      match pq with
        | HeapEmpty -> HeapOne kv
        | HeapOne kvn -> if k < kvn.k then HeapNode(kv,pq,HeapEmpty,2u)
                         else HeapNode(kvn,HeapOne kv,HeapEmpty,2u)
        | HeapNode(kvn,l,r,cnt) ->
          let nc = cnt + 1u
          let nmsk = if msk <> 0u then msk <<< 1 else
                     let s = int32 (System.Math.Log (float nc) / System.Math.Log(2.0))
                     (nc <<< (32 - s)) ||| 1u //never ever zero again with the or'ed 1
          if k <= kvn.k then if (nmsk &&& 0x80000000u) = 0u then HeapNode(kv,insert' kvn nmsk l,r,nc)
                                                            else HeapNode(kv,l,insert' kvn nmsk r,nc)
          else if (nmsk &&& 0x80000000u) = 0u then HeapNode(kvn,insert' kv nmsk l,r,nc)
               else HeapNode(kvn,l,insert' kv nmsk r,nc)
    insert' kv 0u pq

  let private reheapify kv k pq =
    let rec reheapify' pq =
      match pq with
        | HeapEmpty | HeapOne _ -> HeapOne kv
        | HeapNode(kvn,l,r,cnt) ->
            match r with
              | HeapOne kvr when k > kvr.k ->
                  match l with //never HeapEmpty
                    | HeapOne kvl when k > kvl.k -> //both qualify, choose least
                        if kvl.k > kvr.k then HeapNode(kvr,l,HeapOne kv,cnt)
                        else HeapNode(kvl,HeapOne kv,r,cnt)
                    | HeapNode(kvl,_,_,_) when k > kvl.k -> //both qualify, choose least
                        if kvl.k > kvr.k then HeapNode(kvr,l,HeapOne kv,cnt)
                        else HeapNode(kvl,reheapify' l,r,cnt)
                    | _ -> HeapNode(kvr,l,HeapOne kv,cnt) //only right qualifies
              | HeapNode(kvr,_,_,_) when k > kvr.k -> //need adjusting for left leaf or else left leaf
                  match l with //never HeapEmpty or HeapOne
                    | HeapNode(kvl,_,_,_) when k > kvl.k -> //both qualify, choose least
                        if kvl.k > kvr.k then HeapNode(kvr,l,reheapify' r,cnt)
                        else HeapNode(kvl,reheapify' l,r,cnt)
                    | _ -> HeapNode(kvr,l,reheapify' r,cnt) //only right qualifies
              | _ -> match l with //r could be HeapEmpty but l never HeapEmpty
                        | HeapOne(kvl) when k > kvl.k -> HeapNode(kvl,HeapOne kv,r,cnt)
                        | HeapNode(kvl,_,_,_) when k > kvl.k -> HeapNode(kvl,reheapify' l,r,cnt)
                        | _ -> HeapNode(kv,l,r,cnt) //just replace the contents of pq node with sub leaves the same
    reheapify' pq


  let reinsertMinAs k v pq =
    let kv = MinHeapTreeEntry(k,v)
    reheapify kv k pq

  let deleteMin pq =
    let rec delete' kv msk pq =
      match pq with
        | HeapEmpty -> kv,empty //should never get here as should flock off up before an empty is reached
        | HeapOne kvn -> kvn,empty
        | HeapNode(kvn,l,r,cnt) ->
          let nmsk = if msk <> 0u then msk <<< 1 else
                     let s = int32 (System.Math.Log (float cnt) / System.Math.Log(2.0))
                     (cnt <<< (32 - s)) ||| 1u //never ever zero again with the or'ed 1
          if (nmsk &&& 0x80000000u) = 0u then let kvl,pql = delete' kvn nmsk l
                                              match pql with
                                                | HeapEmpty -> kvl,HeapOne kvn
                                                | HeapOne _ | HeapNode _ -> kvl,HeapNode(kvn,pql,r,cnt - 1u)
                                         else let kvr,pqr = delete' kvn nmsk r
                                              kvr,HeapNode(kvn,l,pqr,cnt - 1u)
    match pq with
      | HeapEmpty | HeapOne _ -> empty //for the case of deleting from queue either empty or one entry
      | HeapNode(kv,_,_,cnt) -> let nkv,npq = delete' kv 0u pq in reinsertMinAs nkv.k nkv.v npq

  let adjust f (pq:MinHeapTree<_>) = //adjust all the contents using the function, then rebuild by reheapify
    let rec adjust' pq =
      match pq with
        | HeapEmpty -> pq
        | HeapOne kv -> HeapOne(MinHeapTreeEntry(f kv.k kv.v))
        | HeapNode (kv,l,r,cnt) -> let nkv = MinHeapTreeEntry(f kv.k kv.v)
                                   reheapify nkv nkv.k (HeapNode(kv,adjust' l,adjust' r,cnt))
    adjust' pq

  let ofSeq (sq:seq<MinHeapTreeEntry<_>>) =
    let cnt = sq |> Seq.length |> uint32 in let hcnt = cnt / 2u in let nmrtr = sq.GetEnumerator()
    let rec build' i =
      if nmrtr.MoveNext() && i <= cnt then
        if i > hcnt then HeapOne(nmrtr.Current)
        else let i2 = i + i in HeapNode(nmrtr.Current,build' i2,build' (i2 + 1u),cnt - i)
      else HeapEmpty
    build' 1u

並且以下代碼將deleteMin和ofSeq函數添加到基於數組的版本：

[<RequireQualifiedAccess>]
module MinHeap =

  type MinHeapTreeEntry<'T> = class val k:uint32 val v:'T new(k,v) = { k=k;v=v } end
  type MinHeapTree<'T> = ResizeArray<MinHeapTreeEntry<'T>>

  let empty<'T> = MinHeapTree<MinHeapTreeEntry<'T>>()

  let getMin (pq:MinHeapTree<_>) = if pq.Count > 0 then Some pq.[0] else None

  let insert k v (pq:MinHeapTree<_>) =
    if pq.Count = 0 then pq.Add(MinHeapTreeEntry(0xFFFFFFFFu,v)) //add an extra entry so there's always a right max node
    let mutable nxtlvl = pq.Count in let mutable lvl = nxtlvl <<< 1 //1 past index of value added times 2
    pq.Add(pq.[nxtlvl - 1]) //copy bottom entry then do bubble up while less than next level up
    while ((lvl <- lvl >>> 1); nxtlvl <- nxtlvl >>> 1; nxtlvl <> 0) do
      let t = pq.[nxtlvl - 1] in if t.k > k then pq.[lvl - 1] <- t else lvl <- lvl <<< 1; nxtlvl <- 0 //causes loop break
    pq.[lvl - 1] <-  MinHeapTreeEntry(k,v); pq

  let reinsertMinAs k v (pq:MinHeapTree<_>) = //do minify down for value to insert
    let mutable nxtlvl = 1 in let mutable lvl = nxtlvl in let cnt = pq.Count
    while (nxtlvl <- nxtlvl <<< 1; nxtlvl < cnt) do
      let lk = pq.[nxtlvl - 1].k in let rk = pq.[nxtlvl].k in let oldlvl = lvl
      let k = if k > lk then lvl <- nxtlvl; lk else k in if k > rk then nxtlvl <- nxtlvl + 1; lvl <- nxtlvl
      if lvl <> oldlvl then pq.[oldlvl - 1] <- pq.[lvl - 1] else nxtlvl <- cnt //causes loop break
    pq.[lvl - 1] <- MinHeapTreeEntry(k,v); pq

  let deleteMin (pq:MinHeapTree<_>) =
    if pq.Count <= 2 then empty else //if contains one or less entries, return empty queue
    let btmi = pq.Count - 2 in let btm = pq.[btmi] in pq.RemoveAt btmi
    reinsertMinAs btm.k btm.v pq

  let adjust f (pq:MinHeapTree<_>) = //adjust all the contents using the function, then re-heapify
    if pq <> null then 
      let cnt = pq.Count
      if cnt > 1 then
        for i = 0 to cnt - 2 do //change contents using function
          let e = pq.[i] in let k,v = e.k,e.v in pq.[i] <- MinHeapTreeEntry (f k v)
        for i = cnt/2 downto 1 do //rebuild by reheapify
          let kv = pq.[i - 1] in let k = kv.k
          let mutable nxtlvl = i in let mutable lvl = nxtlvl
          while (nxtlvl <- nxtlvl <<< 1; nxtlvl < cnt) do
            let lk = pq.[nxtlvl - 1].k in let rk = pq.[nxtlvl].k in let oldlvl = lvl
            let k = if k > lk then lvl <- nxtlvl; lk else k in if k > rk then nxtlvl <- nxtlvl + 1; lvl <- nxtlvl
            if lvl <> oldlvl then pq.[oldlvl - 1] <- pq.[lvl - 1] else nxtlvl <- cnt //causes loop break
          pq.[lvl - 1] <- kv
    pq

Answer 5

在Monad.Reader的 第16 期中討論了優先級隊列的功能數據結構，這很有意思。

它包括快速且易於實現的配對堆的描述。

Answer 6

有一個二項堆的實現在這里這是實現優先級隊列的通用數據結構。

Answer 7

只需使用F＃ Set對你的元素類型的具有獨特INT（允許重復），並提取與您的元素set.MinElement或set.MaxElement 。 所有相關操作都是O（log n）時間復雜度。 如果你確實需要O（1）重復訪問最小元素，你可以簡單地緩存它並在插入時更新緩存，如果找到一個新的最小元素。

您可以嘗試多種堆數據結構（傾斜堆，展開堆，配對堆，二項式堆，傾斜二項式堆，以及上述的自舉變體）。 有關其設計，實現和實際性能的詳細分析，請參閱F＃.NET Journal中的文章數據結構：堆 。

Answer 8

使用F＃，您可以使用任何.NET庫，因此如果您可以使用不是使用F＃I Wintellect Power Collection Library編寫的實現。