РЕДАКТИРОВАНИЕ: исправить ошибку в функции deleteMin чисто функциональной версии и добавить функцию ofSeq.
Я реализовал две версии очереди приоритетов на основе двоичной кучи MinHeap в ответе о простых ситах F # , первая - чистый функциональный код (медленнее), а вторая - на основе массива (ResizeArray, который построен на DotNet List, который внутренне использует массив для хранения списка). Нефункциональная версия в некоторой степени оправдана, поскольку MinHeap обычно реализуется как двоичная куча изменяемого массива после модели генеалогического дерева, изобретенной Майклом Эйтзингером более 400 лет назад.
В этом ответе я не реализовал функцию «удалить элемент с верхним приоритетом из очереди», так как алгоритму она не нужна, но я реализовал функцию «повторно вставить верхний элемент дальше по очереди», так как алгоритм нуждался в этом и эта функция очень похожа на то, что требуется для функции «deleteMin»; разница в том, что вместо того, чтобы заново вставлять верхний «минимальный» элемент с новыми параметрами, нужно просто удалить последний элемент из очереди (найденный таким же образом, как при вставке новых элементов, но проще), и повторно вставить этот элемент для замены верхнего (минимальный) элемент в очереди (просто вызовите функцию «reinsertMinAt»). Я также реализовал функцию «настроить», которая применяет функцию ко всем элементам очереди, а затем повторно формирует конечный результат для повышения эффективности, что было требованием алгоритма постраничного сита Эратосфена в этом ответе.
В следующем коде я реализовал функцию «deleteMin», описанную выше, а также функцию «ofSeq», которую можно использовать для создания новой очереди из последовательности элементов пары кортеж приоритет / содержимое, использующих внутреннюю » переосмысление "функция для эффективности.
MinHeap в соответствии с этим кодом может быть легко преобразован в «MaxHeap», если изменить значение «больше чем символы» на значение «меньше чем символы» и наоборот при сравнении значений приоритета «k». Min / Max Heap поддерживает несколько элементов с одним и тем же беззнаковым целочисленным приоритетом «Ключ», но не сохраняет порядок записей с одинаковым приоритетом; другими словами, нет никакой гарантии, что первый элемент, который попадает в очередь, будет первым элементом, который выскакивает до минимальной позиции, если есть другие записи с таким же приоритетом, как я не требовал, и текущий код более эффективен , Код можно изменить, чтобы сохранить порядок, если это было требованием (продолжайте перемещать новые вставки до тех пор, пока не пройдут какие-либо записи с таким же приоритетом).
Приоритетная очередь Min / Max Heap имеет преимущества, заключающиеся в том, что она имеет меньше вычислительных затрат по сравнению с другими типами непростых очередей, выдает Min или Max (в зависимости от того, реализована ли реализация MinHeap или MaxHeap) в O (1 ) время, а также вставляет и удаляет с наихудшим временем O (log n), в то время как для настройки и построения требуется только время O (n), где 'n' - количество элементов, находящихся в данный момент в очереди. Преимущество функции «sertsertMinAs »перед удалением, а затем вставкой заключается в том, что она сокращает время наихудшего случая до O (log n) вдвое и зачастую лучше, поскольку повторные вставки часто располагаются в начале очереди, поэтому полный цикл не требуется.
По сравнению с биномиальной кучей с дополнительной опцией указателя на минимальное значение для получения O (1), чтобы найти минимальное значение производительности, MinHeap может быть немного проще и, следовательно, быстрее при выполнении одной и той же работы, особенно если не нуждается в возможностях «слияния кучи», предлагаемых биномиальной кучей. Может потребоваться больше времени для «повторной вставки MinAs» с использованием функции «слияния» биномиальной кучи по сравнению с использованием MinHeap, поскольку может показаться, что в среднем обычно требуется немного больше сравнений.
Очередь приоритетов MinHeap особенно подходит для проблемы добавочного сита Эратосфена, как и в другом связанном ответе, и, скорее всего, это очередь, используемая Мелиссой Э. О'Нил в работе, проделанной в ее статье , показывающий, что простое сито Тернера на самом деле не является ситом Эратосфена ни по алгоритму, ни по производительности.
Следующий чистый функциональный код добавляет функции «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