F#ライブラリには優先キューが含まれていますか?そうでなければ、誰かがF#での優先度付きキューの実装を私に指摘できますか?
8 に答える
さまざまなデータ構造のF#実装全体については、http://lepensemoi.free.fr/index.php/tag/data-structureを参照してください。
Pervasives.compare関数がなくなり、「compare」関数がベース演算子にマージされたことを除いて、受け入れられた回答が7年間の間に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」の形式で2つのオプションがあることに注意してください。優先度付きキューを使用してプライムをふるいにかけることについての私の回答に記載されているアプリケーションでは、上記のコードはMinHeapの機能実装よりも約80%遅くなります(上記の二項ヒープは-場所の調整); これは、MinHeap実装でこれらの操作を効率的に組み合わせる機能ではなく、二項ヒープの「削除後に挿入」操作の計算がさらに複雑になるためです。
したがって、MinHeap Priority Queueは、このタイプのアプリケーションに適しており、効率的なインプレース調整が必要な場合にも適しています。一方、Binomial Heap Priority Queueは、2つのキューを1つに効率的にマージする機能が必要な場合に適しています。
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
編集済み:純粋関数バージョンのdeleteMin関数のエラーを修正し、ofSeq関数を追加します。
F#プライムシーブに関する回答に2つのバージョンのMinHeapバイナリヒープベースの優先度キューを実装しました。1つ目は純粋関数型コード(低速)で、2つ目は配列ベース(ResizeArray、内部で使用するDotNetリストに基づいて構築されています)です。リストを格納する配列)。MinHeapは通常、400年以上前にMichael Eytzingerによって発明された家系図ベースのモデルの後に、可変配列のバイナリヒープとして実装されるため、機能しないバージョンはある程度正当化されます。
その回答では、アルゴリズムが必要としなかったため、「キューから最優先アイテムを削除」機能を実装しませんでしたが、アルゴリズムが必要としたため、「キューのさらに下に最上位アイテムを再挿入」機能を実装しました。関数は、「deleteMin」関数に必要なものと非常によく似ています。違いは、新しいパラメータで一番上の「最小」アイテムを再挿入するのではなく、キューから最後のアイテムを削除し(新しいアイテムを挿入する場合と同様の方法ですが、より簡単です)、そのアイテムを再挿入して一番上を置き換えることです。キュー内の(最小)アイテム(「reinsertMinAt」関数を呼び出すだけです)。また、すべてのキュー要素に関数を適用し、効率を上げるために最終結果を再ヒープ化する「調整」関数を実装しました。
次のコードでは、上記の「deleteMin」関数と、内部の「reheapify」関数を使用する一連の優先度/コンテンツタプルペア要素から新しいキューを構築するために使用できる「ofSeq」関数を実装しました。効率のために。
このコードによるMinHeapは、優先度「k」の値に関連する比較で、大なり記号を小なり記号に、またはその逆に変更することで、簡単に「MaxHeap」に変更できます。最小/最大ヒープは、同じ符号なし整数「キー」優先度の複数の要素をサポートしますが、同じ優先度のエントリの順序は保持しません。言い換えれば、キューに入る最初の要素が、私が必要としなかったのと同じ優先度を持つ他のエントリがあり、現在のコードがより効率的である場合、最小位置にポップアップする最初の要素になるという保証はありません。それが要件である場合は、コードを変更して順序を保持することができます(同じ優先度のエントリがなくなるまで、新しい挿入を下に移動し続けます)。
最小/最大ヒープ優先度キューには、他のタイプの非単純キューと比較して計算の複雑さのオーバーヘッドが少なく、O(1)時間で最小または最大(MinHeapまたはMaxHeapの実装に応じて)を生成するという利点があります。ワーストケースのO(log n)時間で挿入と削除を行いますが、調整と構築に必要な時間はO(n)時間のみです。ここで、「n」は現在キューにある要素の数です。削除してから挿入するよりも「resinsertMinAs」関数の利点は、O(log n)までの最悪の場合の時間をその2倍から短縮し、再挿入がキューの先頭近くにあることが多いため、多くの場合それよりも優れていることです。フルスイープは必要ありません。
O(1)を生成するための最小値へのポインターの追加オプションを備えた二項ヒープと比較して、最小値のパフォーマンスを見つけるために、MinHeapはわずかに単純であるため、ほぼ同じジョブを実行する場合、特に必要がない場合は高速になります。二項ヒープによって提供される「マージヒープ」機能。通常、平均してわずかに多くの比較を行う必要があるように見えるため、MinHeapを使用する場合と比較して、BinomialHeapの「マージ」関数を使用する場合は「ReinsertMinAs」に時間がかかる場合があります。
MinHeap Priority Queueは、他のリンクされた回答のようにエラトステネスの増分ふるいの問題に特に適しており、MelissaE.O'Neillが彼女の論文で行った作業でTurnerプライムふるいがアルゴリズムに関してもパフォーマンスに関しても、実際にはエラトステネスのふるいではありません。
次の純粋関数型コードは、「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
The Monad.Readerの第16号に、優先キューの機能データ構造に関する説明があります。これは興味深いことです。
これには、高速で実装が非常に簡単なペアリングヒープの説明が含まれています。
Set
(重複を許可するために)一意のintを持つ要素タイプのペアのF#を使用し、set.MinElement
またはで要素を抽出するだけset.MaxElement
です。関連するすべての操作は、O(log n)時間計算量です。最小要素へのO(1)の繰り返しアクセスが本当に必要な場合は、それをキャッシュし、新しい最小要素が見つかった場合は挿入時にキャッシュを更新できます。
試すことができるヒープデータ構造にはさまざまな種類があります(スキューヒープ、スプレイヒープ、ペアリングヒープ、二項ヒープ、スキュー二項ヒープ、上記のブートストラップされたバリアント)。それらの設計、実装、および実際のパフォーマンスの詳細な分析については、「データ構造: F#.NETジャーナルのヒープ」の記事を参照してください。
F#を使用すると、任意の.NETライブラリを使用できるため、F#I Wintellect PowerCollectionLibraryで記述されていない実装を使用しても問題がない場合は。
ここには、優先キューを実装するための一般的なデータ構造である二項ヒープの実装があります。