答案 0 :(得分：14)
答案 1 :(得分：5)
FSharpx.Collections包含一个功能性堆集合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
答案 2 :(得分：5)
令人惊讶的是，除了不再有Pervasives.compare功能和“比较”功能现已合并到F＃中之外，所接受的答案仍然几乎适用于F＃的所有更改。 Microsoft.FSharp.Core.Operators.compare。
中的基本运算符那就是说，引用blog entry将二项式堆实现为通用堆，而不是优先级队列的特定要求，而不需要优先级的泛型类型，只能是整数类型为了提高比较效率，它说明了但没有实现额外的改进，只保留最小值作为单独的字段来提高效率，只需检查队列中的最高优先级项目。
以下模块代码实现了从该代码派生的二项式堆优先级队列，其效率得到提高，它不使用通用比较进行优先级比较，也使用更有效的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”类型有两种选项，以适应测试方式。在my answer about using priority queues to sieve primes中提到的应用程序中，上面的代码比MinHeap的功能实现慢了大约80％（非多处理模式，因为上面的二进制堆不适合就地调整） ;这是因为二项式堆的“删除后插入”操作的额外计算复杂性，而不是为MinHeap实现有效组合这些操作的能力。
因此，MinHeap优先级队列更适合此类应用程序，也适用于需要高效就地调整的情况，而二项式堆优先级队列更适合需要能够有效地将两个队列合并为一个的情况。
答案 3 :(得分：4)
讨论了issue 16 The Monad.Reader中优先级队列的功能数据结构，这很有趣。
它包含对快速且易于实现的配对堆的描述。
答案 4 :(得分：3)
EDITED：纠正纯功能版本的deleteMin函数中的错误并添加ofSeq函数。
我在an answer about F# prime sieves中实现了两个版本的基于MinHeap二进制堆的优先级队列，第一个是纯函数代码（较慢），第二个是基于数组（ResizeArray，它建立在内部的DotNet列表中）使用数组来存储列表）。非功能版本有点合理，因为MinHeap通常在Michael Eytzinger 400多年前发明的基于谱系树的模型之后被实现为可变数组二进制堆。
在那个答案中，我没有实现“从队列中删除最高优先级项”功能，因为算法不需要它，但我确实实现了“重新插入队列中的顶级项目”功能，因为算法确实需要它，该功能与“deleteMin”功能所需的功能非常相似;不同之处在于，不是使用新参数重新插入顶部“最小”项目，而是从队列中删除最后一项（以与插入新项目时相似的方式找到但更简单），并重新插入该项目以替换顶部队列中的（最小）项（只需调用“reinsertMinAt”函数）。我还实现了一个“调整”功能，它将一个函数应用于所有队列元素，然后重新定义效率的最终结果，该函数是该答案中分页筛选的Eratosthenes算法的要求。
在下面的代码中，我实现了上面描述的“deleteMin”函数以及“ofSeq”函数，该函数可用于从使用内部的优先级/内容元组对元素序列构建新队列。重新定义“效率的功能。
根据此代码的MinHeap可以通过在与优先级'k'值相关的比较中将大于符号更改为小于符号而反而更改为“MaxHeap”，反之亦然。 Min / Max Heap支持相同无符号整数“Key”优先级的多个元素，但不保留具有相同优先级的条目的顺序;换句话说，没有保证进入队列的第一个元素将是弹出到最小位置的第一个元素，如果有其他条目具有与我不需要的相同的优先级并且当前代码更有效。如果需要，可以修改代码以保留订单（继续将新插入向下移动直到过去任何具有相同优先级的条目）。
最小/最大堆优先级队列的优点是，与其他类型的非简单队列相比，它具有较少的计算复杂性开销，在O（1中产生Min或Max（取决于MinHeap或MaxHeap实现）） ）时间，以及最坏情况下O（log n）时间的插入和删除，而调整和构建仅需要O（n）时间，其中'n'是当前队列中元素的数量。 “resinsertMinAs”函数优先于删除然后插入的优点是它将最坏情况下的时间减少到O（log n）两倍，并且通常比重新插入通常靠近队列的开头更好。不需要全扫描。
与二项式堆相比，使用指向最小值的指针的额外选项来产生O（1）找到最小值性能，MinHeap可能稍微简单，因此在执行相同的工作时更快，特别是如果一个不需要Binomial Heap提供的“合并堆”功能。与使用MinHeap相比，使用二项式堆“合并”功能“重新插入MinAs”可能需要更长的时间，因为通常需要进行更多的比较。
MinHeap Priority Queue特别适用于Eratosthenes的增量Sieve问题，就像在另一个链接的答案中一样，并且可能是Melissa E. O'Neill在the work done in her paper中使用的队列，显示特纳素数除了算法和性能之外，筛子并不是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
答案 5 :(得分：2)
只需使用具有唯一int的元素类型的F＃Set对（以允许重复）并使用set.MinElement或set.MaxElement提取元素。所有相关操作都是O（log n）时间复杂度。如果你真的需要O（1）重复访问最小元素，你可以简单地缓存它，并在插入时更新缓存，如果找到一个新的最小元素。
您可以尝试多种堆数据结构（倾斜堆，展开堆，配对堆，二项式堆，倾斜二项式堆，以上的自举变体）。有关其设计，实施和实际效果的详细分析，请参阅Data structures: heaps中的文章 The F#.NET Journal 。
答案 6 :(得分：1)
答案 7 :(得分：1)