Очередь приоритетов F #

В библиотеку F # входит очередь приоритетов? Else может кто-нибудь указать мне реализацию очереди приоритетов в F #?

Ответ 4

Удивительно, что принятый ответ по-прежнему почти работает со всеми изменениями F # в течение семи лет, за исключением того, что функция Pervasives.compare больше не функционирует, и теперь функция сравнения сравнивается с базовые операторы в Microsoft.FSharp.Core.Operators.compare.

Тем не менее, ссылка запись в блоге реализует биномиальную кучу как кучу общего назначения, а не для конкретных требований очереди приоритетов что не требует универсального типа для приоритета, который может быть просто целым типом для эффективности в сравнении, и он говорит, но не реализует дополнительного улучшения, чтобы сохранить минимум как отдельное поле для эффективности, просто проверяя элемент верхнего приоритета в очереди.

Следующий код модуля реализует очередь приоритетов биномиальной кучи как полученную из этого кода с повышенной эффективностью, что он не использует общие сравнения для сопоставлений приоритетов и более эффективный метод O (1) для проверки верха очереди ( хотя за счет дополнительных накладных расходов для вставки и удаления записей, хотя они все еще O (log n) - n - количество записей в очереди). Этот код более подходит для обычного применения очередей приоритетов, где верхняя часть очереди читается чаще, чем вставки и/или удаление элементов верхнего элемента. Обратите внимание, что он не так эффективен, как MinHeap, когда один удаляет верхний элемент и снова вставляет его дальше в очередь, так как полный "deleteMin" и "insert" должен выполняться с гораздо большей вычислительной нагрузкой. Код выглядит следующим образом:

[<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", чтобы он соответствовал способу тестирования. В заявлении, указанном в моем ответе об использовании очередей приоритетов для ситовых простых чисел, приведенный выше код примерно на 80% медленнее, чем функциональная реализация MinHeap (не мультипроцессорная обработка режим, так как вышеупомянутая биномиальная куча не поддаётся правильной корректировке на месте); это связано с дополнительной вычислительной сложностью операции "удалить с последующим вставкой" для биномиальной кучи, а не с возможностью эффективного объединения этих операций для реализации MinHeap.

Таким образом, очередь приоритетов MinHeap более подходит для этого типа приложений, а также там, где требуются эффективные корректировки на месте, тогда как очередность приоритетов Binomial Heap более подходит там, где требуется способность эффективно объединить две очереди в одну.

Ответ 5

Существует обсуждение функциональных структур данных для очередей приоритетов в проблема 16 The Monad.Reader, что интересно.

Он включает описание спаривания, которое быстро и очень легко реализуется.

Ответ 6

EDITED: исправить ошибку в функции deleteMin чистой функциональной версии и добавить функцию ofSeq.

Я реализовал две версии очереди приоритетов MinHeap Binary Heap в ответе о первичных ситах F #, первый - чистый функциональный код (медленнее), а второй основан на массиве (ResizeArray, который построен на списке DotNet, который внутренне использует массив для хранения списка). Нефункциональная версия несколько оправдана, так как MinHeap обычно реализуется как мутировальная куча изменчивого массива после генеалогической древовидной модели, изобретенной Michael Eytzinger более 400 лет назад.

В этом ответе я не реализовал функцию "удалить главный приоритет из очереди", поскольку алгоритм не нуждался в ней, но я реализовал функцию "повторного ввода верхнего пункта дальше в очередь", поскольку алгоритм действительно нуждался в этом, и эта функция очень похожа на то, что потребуется для функции "deleteMin" ; разница заключается в том, что вместо повторного ввода верхнего "минимального" элемента с новыми параметрами можно просто удалить последний элемент из очереди (найденный аналогично тому, как при вставке новых элементов, но проще) и снова вставить этот элемент, чтобы заменить верхний (минимальный) в очереди (просто вызовите функцию reinsertMinAt). Я также внедрил функцию "adjust", которая применяет функцию ко всем элементам очереди, а затем регенерирует конечный результат для эффективности, эта функция была требованием алгоритма Sieve алгоритма Эратосфена в этом ответе.

В следующем коде я реализовал описанную выше функцию "deleteMin" , а также функцию "ofSeq", которая может использоваться для построения новой очереди из последовательности элементов пары кортежей приоритета/содержимого, которая использует внутреннюю "reheapify" для эффективности.

MinHeap в соответствии с этим кодом можно легко изменить в "MaxHeap", изменив символы больше, чем символы, и наоборот, в сравнении с значениями приоритета "k". Min/Max Heap поддерживает несколько элементов одного и того же неподписанного целочисленного значения "Ключ", но не сохраняет порядок записей с одинаковым приоритетом; другими словами, нет гарантии, что первый элемент, который входит в очередь, будет первым элементом, который появляется до минимальной позиции, если есть другие записи с таким же приоритетом, как я этого не требовал, и текущий код более эффективен, Код может быть изменен, чтобы сохранить заказ, если это было требованием (продолжайте перемещать новые вставки до тех пор, пока в прошлом не будут зарегистрированы те же приоритеты).

Приоритет Min/Max Heap Priority Queue имеет преимущества в том, что он имеет меньшие накладные расходы вычислительной сложности по сравнению с другими типами упрощенных очередей, создает Min или Max (в зависимости от реализации MinHeap или MaxHeap) в O (1), а также вставляет и удаляет с наихудшим временем O (log n), тогда как для настройки и построения требуется только время O (n), где "n" - количество элементов, находящихся в очереди. Преимущество функции resinsertMinAs над удалением, а затем вставки заключается в том, что он уменьшает наихудшее временное время до O (log n) в два раза выше и часто лучше, чем повторное вхождение в начале очереди, поэтому полная развертка не требуется.

По сравнению с биномиальной кучей с дополнительной опцией указателя на минимальное значение, чтобы произвести O (1), найти минимальное значение производительности, MinHeap может быть немного проще и, следовательно, быстрее при выполнении одной и той же работы, особенно если один не нуждается в возможностях "кучи слияния", предлагаемых биномиальной кучей. Это может занять больше времени, чем "reinsertMinAs", используя функцию "слияния биномиальной кучи" по сравнению с использованием MinHeap, поскольку, как кажется, обычно требуется немного больше сравнений.

Очередь приоритетов MinHeap особенно подходит для проблемы инкрементного сита Эратосфена, как и в другом связанном ответе, и, скорее всего, очередь, используемая Мелиссой Э. О'Нил в сделанная в ее работе работа, показывающая, что первичное сито 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 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

Ответ 7

Просто используйте пары F # Set для пар вашего типа элемента с уникальным int (чтобы разрешить дубликаты) и извлеките ваши элементы с помощью set.MinElement или set.MaxElement. Все соответствующие операции - это временная сложность O (log n). Если вам действительно нужен O (1) повторный доступ к минимальному элементу, вы можете просто кэшировать его и обновлять кеш при вставке, если найден новый минимальный элемент.

Существует много типов структур данных кучи, которые вы могли бы попробовать (перекошенные кучи, распашные кучи, спаривание куч, биномиальные кучи, перекосы биномиальных куч, загруженные варианты выше). Подробный анализ их дизайна, реализации и реальной производительности см. В статье Структуры данных: кучи в Журнал F #.NET.

Ответ 8

С помощью F # вы можете использовать любую библиотеку .NET, поэтому, если вы в порядке с использованием реализации, которая не написана в F # я Wintellect Power Collection Библиотека.