## Component Pascal

BlackBox Component Builder

```oberon2

MODULE PQueues;
IMPORT StdLog,Boxes;

TYPE
  Rank* = POINTER TO RECORD
    p-: LONGINT; (* Priority *)
    value-: Boxes.Object
  END;

  PQueue* = POINTER TO RECORD
    a: POINTER TO ARRAY OF Rank;
    size-: LONGINT;
  END;

  PROCEDURE NewRank*(p: LONGINT; v: Boxes.Object): Rank;
  VAR
    r: Rank;
  BEGIN
    NEW(r);r.p := p;r.value := v;
    RETURN r
  END NewRank;

  PROCEDURE NewPQueue*(cap: LONGINT): PQueue;
  VAR
    pq: PQueue;
  BEGIN
    NEW(pq);pq.size := 0;
    NEW(pq.a,cap);pq.a[0] := NewRank(MIN(INTEGER),NIL);
    RETURN pq
  END NewPQueue;

  PROCEDURE (pq: PQueue) Push*(r:Rank), NEW;
  VAR
    i: LONGINT;
  BEGIN
    INC(pq.size);
    i := pq.size;
    WHILE r.p < pq.a[i DIV 2].p DO
      pq.a[i] := pq.a[i DIV 2];i := i DIV 2
    END;
    pq.a[i] := r
  END Push;

  PROCEDURE (pq: PQueue) Pop*(): Rank,NEW;
  VAR
    r,y: Rank;
    i,j: LONGINT;
    ok: BOOLEAN;
  BEGIN
    r := pq.a[1]; (* Priority object *)
    y := pq.a[pq.size]; DEC(pq.size); i := 1; ok := FALSE;
    WHILE (i <= pq.size DIV 2) & ~ok DO
      j := i + 1;
      IF (j < pq.size) & (pq.a[i].p > pq.a[j + 1].p) THEN INC(j) END;
      IF y.p > pq.a[j].p THEN pq.a[i] := pq.a[j]; i := j ELSE ok := TRUE END
    END;
    pq.a[i] := y;
    RETURN r
  END Pop;

  PROCEDURE (pq: PQueue) IsEmpty*(): BOOLEAN,NEW;
  BEGIN
    RETURN pq.size = 0
  END IsEmpty;

  PROCEDURE Test*;
  VAR
    pq: PQueue;
    r: Rank;
    PROCEDURE ShowRank(r:Rank);
    BEGIN
      StdLog.Int(r.p);StdLog.String(":> ");StdLog.String(r.value.AsString());StdLog.Ln;
    END ShowRank;
  BEGIN
    pq := NewPQueue(128);
    pq.Push(NewRank(3,Boxes.NewString("Clear drains")));
    pq.Push(NewRank(4,Boxes.NewString("Feed cat")));
    pq.Push(NewRank(5,Boxes.NewString("Make tea")));
    pq.Push(NewRank(1,Boxes.NewString("Solve RC tasks")));
    pq.Push(NewRank(2,Boxes.NewString("Tax return")));
    ShowRank(pq.Pop());
    ShowRank(pq.Pop());
    ShowRank(pq.Pop());
    ShowRank(pq.Pop());
    ShowRank(pq.Pop());
  END Test;

END PQueues.

Interface extracted from the implementation

DEFINITION PQueues;

  IMPORT Boxes;

  TYPE
    PQueue = POINTER TO RECORD
      size-: LONGINT;
      (pq: PQueue) IsEmpty (): BOOLEAN, NEW;
      (pq: PQueue) Pop (): Rank, NEW;
      (pq: PQueue) Push (r: Rank), NEW
    END;

    Rank = POINTER TO RECORD
      p-: LONGINT;
      value-: Boxes.Object
    END;

  PROCEDURE NewPQueue (cap: LONGINT): PQueue;
  PROCEDURE NewRank (p: LONGINT; v: Boxes.Object): Rank;
  PROCEDURE Test;

END PQueues.

Execute: ^Q PQueues.Test
Output:

 1:> Solve RC tasks
 2:> Tax return
 3:> Clear drains
 4:> Feed cat
 5:> Make tea

D

import std.stdio, std.container, std.array, std.typecons;

void main() {
    alias tuple T;
    auto heap = heapify([T(3, "Clear drains"),
                         T(4, "Feed cat"),
                         T(5, "Make tea"),
                         T(1, "Solve RC tasks"),
                         T(2, "Tax return")]);

    while (!heap.empty) {
        writeln(heap.front);
        heap.removeFront();
    }
}

{{out}}

Tuple!(int,string)(5, "Make tea")
Tuple!(int,string)(4, "Feed cat")
Tuple!(int,string)(3, "Clear drains")
Tuple!(int,string)(2, "Tax return")
Tuple!(int,string)(1, "Solve RC tasks")

EchoLisp

We use the built-in binary tree library. Each tree node has a datum (key . value). The functions (bin-tree-pop-first tree) and (bin-tree-pop-last tree) allow to extract the node with highest or lowest priority.

(lib 'tree)
(define tasks (make-bin-tree 3 "Clear drains"))
(bin-tree-insert tasks 2 "Tax return")
(bin-tree-insert tasks 5 "Make tea")
(bin-tree-insert tasks 1 "Solve RC tasks")
(bin-tree-insert tasks 4 "Feed 🐡")

(bin-tree-pop-first tasks) → (1 . "Solve RC tasks")
(bin-tree-pop-first tasks) → (2 . "Tax return")
(bin-tree-pop-first tasks) → (3 . "Clear drains")
(bin-tree-pop-first tasks) → (4 . "Feed 🐡")
(bin-tree-pop-first tasks) → (5 . "Make tea")
(bin-tree-pop-first tasks) → null

;; similarly
(bin-tree-pop-last tasks) → (5 . "Make tea")
(bin-tree-pop-last tasks) → (4 . "Feed 🐡")
; etc.

Elixir

{{trans|Erlang}}

defmodule Priority do
  def create, do: :gb_trees.empty

  def insert( element, priority, queue ), do: :gb_trees.enter( priority, element, queue )

  def peek( queue ) do
    {_priority, element, _new_queue} = :gb_trees.take_smallest( queue )
    element
  end

  def task do
    items = [{3, "Clear drains"}, {4, "Feed cat"}, {5, "Make tea"}, {1, "Solve RC tasks"}, {2, "Tax return"}]
    queue = Enum.reduce(items, create, fn({priority, element}, acc) -> insert( element, priority, acc ) end)
    IO.puts "peek priority: #{peek( queue )}"
    Enum.reduce(1..length(items), queue, fn(_n, q) -> write_top( q ) end)
  end

  def top( queue ) do
    {_priority, element, new_queue} = :gb_trees.take_smallest( queue )
    {element, new_queue}
  end

  defp write_top( q ) do
    {element, new_queue} = top( q )
    IO.puts "top priority: #{element}"
    new_queue
  end
end

Priority.task

{{out}}

peek priority: Solve RC tasks
top priority: Solve RC tasks
top priority: Tax return
top priority: Clear drains
top priority: Feed cat
top priority: Make tea

Erlang

Using built in gb_trees module, with the suggested interface for this task.

-module( priority_queue ).

-export( [create/0, insert/3, peek/1, task/0, top/1] ).

create() -> gb_trees:empty().

insert( Element, Priority, Queue ) -> gb_trees:enter( Priority, Element, Queue ).

peek( Queue ) ->
  {_Priority, Element, _New_queue} = gb_trees:take_smallest( Queue ),
  Element.

task() ->
  Items = [{3, "Clear drains"}, {4, "Feed cat"}, {5, "Make tea"}, {1, "Solve RC tasks"}, {2, "Tax return"}],
  Queue = lists:foldl( fun({Priority, Element}, Acc) -> insert( Element, Priority, Acc ) end, create(), Items ),
  io:fwrite( "peek priority: ~p~n", [peek( Queue )] ),
  lists:foldl( fun(_N, Q) -> write_top( Q ) end, Queue, lists:seq(1, erlang:length(Items)) ).

top( Queue ) ->
  {_Priority, Element, New_queue} = gb_trees:take_smallest( Queue ),
  {Element, New_queue}.



write_top( Q ) ->
  {Element, New_queue} = top( Q ),
  io:fwrite( "top priority: ~p~n", [Element] ),
  New_queue.

{{out}}

12> priority_queue:task().
peek priority: "Solve RC tasks"
top priority: "Solve RC tasks"
top priority: "Tax return"
top priority: "Clear drains"
top priority: "Feed cat"
top priority: "Make tea"

F Sharp

The below codes all provide the standard priority queue functions of "peekMin", "push", and "deleteMin"; as well, "replaceMin" which can be much more efficient that a "deleteMin" followed by a "push" for some types of queues), "popMin" (generally a convenience function for "peekMin" followed by "deleteMin"), "adjust" for applying a function to all queue entries and reheapifying, "fromSeq" for building a queue from a sequence, "toSeq" for outputting a sorted sequence of the queue contents, and "sort" which is a convenience function combining the latter two functions are provided. Finally, the queue's all provide a "merge" function to combine two queues into one, and an "adjust" function which applies a function to every heap element and reheapifies.

Functional

'''Binomial Heap Priority Queue'''

The following Binomial Heap Priority Queue code has been adapted [http://cs.hubfs.net/topic/None/56608 from a version by "DeeJay"] updated for changes in F# over the intervening years, and implementing the O(1) "peekMin" mentioned in that post; in addition to the above standard priority queue functions, it also implements the "merge" function for which the Binomial Heap is particularly suited, taking O(log n) time rather than the usual O(n) (or worse) time:

]
module PriorityQ =

//  type 'a treeElement = Element of uint32 * 'a
  type 'a treeElement = struct 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

  [<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
  [<NoEquality; NoComparison>]
  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 peekMin = function | HeapEmpty -> None
                         | HeapNotEmpty(min, _) -> Some (min.k, min.v)

  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 push 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 replaceMin k v pq = push k v (deleteMin pq)

  let fromSeq sq = Seq.fold (fun pq (k, v) -> push k v pq) empty sq

  let popMin pq = match peekMin pq with
                      | None -> None
                      | Some(kv) -> Some(kv, deleteMin pq)

  let toSeq pq = Seq.unfold popMin pq

  let sort sq = sq |> fromSeq |> toSeq

  let adjust f pq = pq |> toSeq |> Seq.map (fun (k, v) -> f k v) |> fromSeq

"isEmpty", "empty", and "peekMin" all have O(1) performance, "push" is O(1) amortized performance with O(log n) worst case, and the rest are O(log n) except for "fromSeq" (and thus "sort" and "adjust") which have O(n log n) performance since they use repeated "deleteMin" with one per entry.

No "size" function is provided, but it would be implemented by summing the total size of all the nested tree lists, which each have a "Count" property and thus would be quite fast.

Note that the current "adjust" function is horribly inefficient as it outputs the original queue as a sorted sequence (O(n log n) time complexity), maps the adjusting function to each element, and rebuilds the queue be repeated "push" operations of the resulting sequence. This could be improved by re-writing to output the sequence in unsorted order (using an internal function that doesn't use repeated "deleteMin" operations) and then rebuilding from the adjusted sequence; doing this would make the "adjust" operation take O(n) amortized time.

The "sort" function also uses a similar technique of building a queue from a sequence by repeated "push" operations (however, those only take O(n) amortized time for the Binomial Heap), then outputting a sorted sequence by repeated "popMin" operations for a combined O(n log n) time complexity.

'''Min Heap Priority Queue'''

The following code implementing a Min Heap Priority Queue is adapted from the [http://www.cl.cam.ac.uk/~lp15/MLbook/programs/sample4.sml ML PRIORITY_QUEUE code by Lawrence C. Paulson] including separating the key/value pairs as separate entries in the data structure for better comparison efficiency; it implements an efficient "fromSeq" function using reheapify for which the Min Heap is particularly suited as it has only O(n) instead of O(n log n) computational time complexity, which method is also used for the "adjust" and "merge" functions:

]
module PriorityQ =

  type HeapEntry<'V> = struct val k:uint32 val v:'V new(k,v) = {k=k;v=v} end
  [<CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
  [<NoEquality; NoComparison>]
  type PQ<'V> =
         | Mt
         | Br of HeapEntry<'V> * PQ<'V> * PQ<'V>

  let empty = Mt

  let isEmpty = function | Mt -> true
                         | _  -> false

  // Return number of elements in the priority queue.
  // /O(log(n)^2)/
  let rec size = function
    | Mt -> 0
    | Br(_, ll, rr) ->
        let n = size rr
        // rest n p q, where n = size ll, and size ll - size rr = 0 or 1
        // returns 1 + size ll - size rr.
        let rec rest n pl pr =
          match pl with
            | Mt -> 1
            | Br(_, pll, plr) ->
                match pr with
                  | Mt -> 2
                  | Br(_, prl, prr) ->
                      let nm1 = n - 1 in let d = nm1 >>> 1
                      if (nm1 &&& 1) = 0
                        then rest d pll prl // subtree sizes: (d or d+1), d; d, d
                        else rest d plr prr // subtree sizes: d+1, (d or d+1); d+1, d
        2 * n + rest n ll rr

  let peekMin = function | Br(kv, _, _) -> Some(kv.k, kv.v)
                         | _            -> None

  let rec push wk wv =
    function | Mt -> Br(HeapEntry(wk, wv), Mt, Mt)
             | Br(vkv, ll, rr) ->
                 if wk <= vkv.k then
                   Br(HeapEntry(wk, wv), push vkv.k vkv.v rr, ll)
                 else Br(vkv, push wk wv rr, ll)

  let inline private siftdown wk wv pql pqr =
    let rec sift pl pr =
      match pl with
        | Mt -> Br(HeapEntry(wk, wv), Mt, Mt)
        | Br(vkvl, pll, plr) ->
            match pr with
              | Mt -> if wk <= vkvl.k then Br(HeapEntry(wk, wv), pl, Mt)
                      else Br(vkvl, Br(HeapEntry(wk, wv), Mt, Mt), Mt)
              | Br(vkvr, prl, prr) ->
                  if wk <= vkvl.k && wk <= vkvr.k then Br(HeapEntry(wk, wv), pl, pr)
                  elif vkvl.k <= vkvr.k then Br(vkvl, sift pll plr, pr)
                  else Br(vkvr, pl, sift prl prr)
    sift pql pqr

  let replaceMin wk wv = function | Mt -> Mt
                                  | Br(_, ll, rr) -> siftdown wk wv ll rr

  let deleteMin = function
        | Mt -> Mt
        | Br(_, ll, Mt) -> ll
        | Br(vkv, ll, rr) ->
          let rec leftrem = function | Mt -> vkv, Mt // should never happen
                                     | Br(kvd, Mt, _) -> kvd, Mt
                                     | Br(vkv, Br(kvd, _, _), Mt) ->
                                                 kvd, Br(vkv, Mt, Mt)
                                     | Br(vkv, pl, pr) -> let kvd, pqd = leftrem pl
                                                          kvd, Br(vkv, pr, pqd)
          let (kvd, pqd) = leftrem ll
          siftdown kvd.k kvd.v rr pqd;

  let adjust f pq =
        let rec adj = function
              | Mt -> Mt
              | Br(vkv, ll, rr) -> let nk, nv = f vkv.k vkv.v
                                   siftdown nk nv (adj ll) (adj rr)
        adj pq

  let fromSeq sq =
    if Seq.isEmpty sq then Mt
    else let nmrtr = sq.GetEnumerator()
         let rec build lvl = if lvl = 0 || not (nmrtr.MoveNext()) then Mt
                             else let ck, cv = nmrtr.Current
                                  let lft = lvl >>> 1
                                  let rght = (lvl - 1) >>> 1
                                  siftdown ck cv (build lft) (build rght)
         build (sq |> Seq.length)

  let merge (pq1:PQ<_>) (pq2:PQ<_>) = // merges without using a sequence
    match pq1 with
      | Mt -> pq2
      | _ ->
        match pq2 with
          | Mt -> pq1
          | _ ->
            let rec zipper lvl pq rest =
              if lvl = 0 then Mt, pq, rest else
              let lft = lvl >>> 1 in let rght = (lvl - 1) >>> 1
              match pq with
                | Mt ->
                  match rest with
                    | [] | Mt :: _ -> Mt, pq, [] // Mt in list never happens
                    | Br(kv, ll, Mt) :: tl ->
                        let pl, pql, rstl = zipper lft ll tl
                        let pr, pqr, rstr = zipper rght pql rstl
                        siftdown kv.k kv.v pl pr, pqr, rstr
                    | Br(kv, ll, rr) :: tl ->
                        let pl, pql, rstl = zipper lft ll (rr :: tl)
                        let pr, pqr, rstr = zipper rght pql rstl
                        siftdown kv.k kv.v pl pr, pqr, rstr
                | Br(kv, ll, Mt) ->
                    let pl, pql, rstl = zipper lft ll rest
                    let pr, pqr, rstr = zipper rght pql rstl
                    siftdown kv.k kv.v pl pr, pqr, rstr
                | Br(kv, ll, rr) ->
                    let pl, pql, rstl = zipper lft ll (rr :: rest)
                    let pr, pqr, rstr = zipper rght pql rstl
                    siftdown kv.k kv.v pl pr, pqr, rstr
            let sz = size pq1 + size pq2
            let pq, _, _ = zipper sz pq1 [pq2] in pq

  let popMin pq = match peekMin pq with
                      | None -> None
                      | Some(kv) -> Some(kv, deleteMin pq)

  let toSeq pq = Seq.unfold popMin pq

  let sort sq = sq |> fromSeq |> toSeq

The above code implements a "merge" function so that no internal sequence generation is necessary as generation of sequence iterators is quite inefficient in F# for a combined O(n) computational time complexity but a considerable reduction in the constant factor overhead.

Other than the "merge" function, the Min Heap Priority Queue has the same time complexity as for the Binomial Heap Priority Queue above except that "push" has O(log n) performance rather than the amortized O(1) performance; however, the Binomial Heap Priority Queue is generally a constant factor slower due to more complex operations. The Binomial Heap Priority Queue is generally more suited when used where merging of large queues or frequent "push" operations are used; the Min Heap Priority Queue is more suitable for use when replacing the value at the minimum entry of the queue is frequently required, especially when the adjusted value is not displaced very far down the queue on average.

Imperative

'''Min Heap Priority Queue'''

As the Min Heap is usually implemented as a [http://opendatastructures.org/versions/edition-0.1e/ods-java/10_1_BinaryHeap_Implicit_Bi.html mutable array binary heap] after a genealogical tree based model invented by [https://en.wikipedia.org/wiki/Michael_Eytzinger Michael Eytzinger] over 400 years ago, the following "ugly imperative" code implements the Min Heap Priority Queue this way; note that the code could be implemented not using "ugly" mutable state variables other than the contents of the array (DotNet List which implements a growable array) but in this case the code would be considerably slower as in not much faster or slower than the functional version since using mutable side effects greatly reduces the number of operations:

]
module PriorityQ =

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

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

  let isEmpty (pq: MinHeapTree<_>) = pq.Count = 0

  let size (pq: MinHeapTree<_>) = let cnt = pq.Count
                                  if cnt = 0 then 0 else cnt - 1

  let peekMin (pq:MinHeapTree<_>) = if pq.Count > 1 then let kv = pq.[0]
                                                         Some (kv.k, kv.v) else None

  let push k v (pq:MinHeapTree<_>) =
    if pq.Count = 0 then pq.Add(HeapEntry(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] <-  HeapEntry(k,v); pq

  let inline private siftdown k v ndx (pq: MinHeapTree<_>) =
    let mutable i = ndx in let mutable ni = i in let cnt = pq.Count - 1
    while (ni <- ni + ni + 1; ni < cnt) do
      let lk = pq.[ni].k in let rk = pq.[ni + 1].k in let oi = i
      let k = if k > lk then i <- ni; lk else k in if k > rk then ni <- ni + 1; i <- ni
      if i <> oi then pq.[oi] <- pq.[i] else ni <- cnt //causes loop break
    pq.[i] <- HeapEntry(k,v)

  let replaceMin k v (pq:MinHeapTree<_>) = siftdown k v 0 pq; pq

  let deleteMin (pq:MinHeapTree<_>) =
    let lsti = pq.Count - 2
    if lsti <= 0 then pq.Clear(); pq else
    let lstkv = pq.[lsti]
    pq.RemoveAt(lsti)
    siftdown lstkv.k lstkv.v 0 pq; pq

  let adjust f (pq:MinHeapTree<_>) = //adjust all the contents using the function, then re-heapify
    let cnt = pq.Count - 1
    let rec adj i =
      let lefti = i + i + 1 in let righti = lefti + 1
      let ckv = pq.[i] in let (nk, nv) = f ckv.k ckv.v
      if righti < cnt then adj righti
      if lefti < cnt then adj lefti; siftdown nk nv i pq
      else pq.[i] <- HeapEntry(nk, nv)
    adj 0; pq

  let fromSeq sq =
    if Seq.isEmpty sq then empty
    else let pq = new MinHeapTree<_>(sq |> Seq.map (fun (k, v) -> HeapEntry(k, v)))
         let sz = pq.Count in let lkv = pq.[sz - 1]
         pq.Add(HeapEntry(UInt32.MaxValue, lkv.v))
         let rec build i =
           let lefti = i + i + 1
           if lefti < sz then
             let righti = lefti + 1 in build lefti; build righti
             let ckv = pq.[i] in siftdown ckv.k ckv.v i pq
         build 0; pq

  let merge (pq1:MinHeapTree<_>) (pq2:MinHeapTree<_>) =
    if pq2.Count = 0 then pq1 else
    if pq1.Count = 0 then pq2 else
    let pq = empty
    pq.AddRange(pq1); pq.RemoveAt(pq.Count - 1)
    pq.AddRange(pq2)
    let sz = pq.Count - 1
    let rec build i =
      let lefti = i + i + 1
      if lefti < sz then
        let righti = lefti + 1 in build lefti; build righti
        let ckv = pq.[i] in siftdown ckv.k ckv.v i pq
    build 0; pq

  let popMin pq = match peekMin pq with
                   | None     -> None
                   | Some(kv) -> Some(kv, deleteMin pq)

  let toSeq pq = Seq.unfold popMin pq

  let sort sq = sq |> fromSeq |> toSeq

The comments for the above code are the same as for the functional version; the main difference is that the imperative code takes about two thirds of the time on average.

All of the above codes can be tested under the F# REPL using the following:

 let testseq = [| (3u, "Clear drains");
                   (4u, "Feed cat");
                   (5u, "Make tea");
                   (1u, "Solve RC tasks");
                   (2u, "Tax return") |] |> Array.toSeq
  let testpq = testseq |> MinHeap.fromSeq
  testseq |> Seq.fold (fun pq (k, v) -> MinHeap.push k v pq) MinHeap.empty
  |> MinHeap.toSeq |> Seq.iter (printfn "%A") // test slow build
  printfn ""
  testseq |> MinHeap.fromSeq |> MinHeap.toSeq // test fast build
   |> Seq.iter (printfn "%A")
  printfn ""
  testseq |> MinHeap.sort |> Seq.iter (printfn "%A") // convenience function
  printfn ""
  MinHeap.merge testpq testpq // test merge
  |> MinHeap.toSeq |> Seq.iter (printfn "%A")
  printfn ""
  testpq |> MinHeap.adjust (fun k v -> uint32 (MinHeap.size testpq) - k, v)
  |> MinHeap.toSeq |> Seq.iter (printfn "%A") // test adjust;;

to produce the following output: {{output}}

(1u, "Solve RC tasks")
(2u, "Tax return")
(3u, "Clear drains")
(4u, "Feed cat")
(5u, "Make tea")

(1u, "Solve RC tasks")
(2u, "Tax return")
(3u, "Clear drains")
(4u, "Feed cat")
(5u, "Make tea")

(1u, "Solve RC tasks")
(2u, "Tax return")
(3u, "Clear drains")
(4u, "Feed cat")
(5u, "Make tea")

(1u, "Solve RC tasks")
(1u, "Solve RC tasks")
(2u, "Tax return")
(2u, "Tax return")
(3u, "Clear drains")
(3u, "Clear drains")
(4u, "Feed cat")
(4u, "Feed cat")
(5u, "Make tea")
(5u, "Make tea")

(0u, "Make tea")
(1u, "Feed cat")
(2u, "Clear drains")
(3u, "Tax return")
(4u, "Solve RC tasks")
val it : unit = ()

Note that the code using "fromSeq" instead of repeated "push" operations to build a queue is considerably faster for large random-order entry sequences.

Also note that the imperative version modifies the state of the "testpq" binding for modification operations such as "push" and "deleteMin" or operations derived from those; this means that if the last two tests were reversed then the "merge" would be passed zero sized queues since the "testpq" would have been reduced by the "toSeq" operation (which effectively uses repeated "deleteMin" functions).

Factor

Factor has priority queues implemented in the library: documentation is available at http://docs.factorcode.org/content/article-heaps.html (or by typing "heaps" help interactively in the listener).

<min-heap> [ {
    { 3 "Clear drains" }
    { 4 "Feed cat" }
    { 5 "Make tea" }
    { 1 "Solve RC tasks" }
    { 2 "Tax return" }
  } swap heap-push-all
] [
  [ print ] slurp-heap
] bi

output:

Solve RC tasks
Tax return
Clear drains
Feed cat
Make tea

Fortran

module priority_queue_mod
implicit none

type node
  character (len=100)              :: task
  integer                          :: priority
end type

type queue
  type(node), allocatable :: buf(:)
  integer                 :: n = 0
contains
  procedure :: top
  procedure :: enqueue
  procedure :: siftdown
end type

contains

subroutine siftdown(this, a)
  class (queue)           :: this
  integer                 :: a, parent, child
  associate (x => this%buf)
  parent = a
  do while(parent*2 <= this%n)
    child = parent*2
    if (child + 1 <= this%n) then
      if (x(child+1)%priority > x(child)%priority ) then
        child = child +1
      end if
    end if
    if (x(parent)%priority < x(child)%priority) then
      x([child, parent]) = x([parent, child])
      parent = child
    else
      exit
    end if
  end do
  end associate
end subroutine

function top(this) result (res)
  class(queue) :: this
  type(node)   :: res
  res = this%buf(1)
  this%buf(1) = this%buf(this%n)
  this%n = this%n - 1
  call this%siftdown(1)
end function

subroutine enqueue(this, priority, task)
  class(queue), intent(inout) :: this
  integer                     :: priority
  character(len=*)            :: task
  type(node)                  :: x
  type(node), allocatable     :: tmp(:)
  integer                     :: i
  x%priority = priority
  x%task = task
  this%n = this%n +1
  if (.not.allocated(this%buf)) allocate(this%buf(1))
  if (size(this%buf)<this%n) then
    allocate(tmp(2*size(this%buf)))
    tmp(1:this%n-1) = this%buf
    call move_alloc(tmp, this%buf)
  end if
  this%buf(this%n) = x
  i = this%n
  do
    i = i / 2
    if (i==0) exit
    call this%siftdown(i)
  end do
end subroutine
end module

program main
  use priority_queue_mod

  type (queue) :: q
  type (node)  :: x

  call q%enqueue(3, "Clear drains")
  call q%enqueue(4, "Feed cat")
  call q%enqueue(5, "Make Tea")
  call q%enqueue(1, "Solve RC tasks")
  call q%enqueue(2, "Tax return")

  do while (q%n >0)
    x = q%top()
    print "(g0,a,a)", x%priority, " -> ", trim(x%task)
  end do

end program

! Output:
! 5 -> Make Tea
! 4 -> Feed cat
! 3 -> Clear drains
! 2 -> Tax return
! 1 -> Solve RC tasks

FunL

import util.ordering
native scala.collection.mutable.PriorityQueue

data Task( priority, description )

def comparator( Task(a, _), Task(b, _) )
  | a > b     = -1
  | a < b     =  1
  | otherwise =  0

q = PriorityQueue( ordering(comparator) )

q.enqueue(
  Task(3, 'Clear drains'),
  Task(4, 'Feed cat'),
  Task(5, 'Make tea'),
  Task(1, 'Solve RC tasks'),
  Task(2, 'Tax return')
  )

while not q.isEmpty()
  println( q.dequeue() )

{{out}}

Task(1, Solve RC tasks)
Task(2, Tax return)
Task(3, Clear drains)
Task(4, Feed cat)
Task(5, Make tea)

Go

Go's standard library contains the container/heap package, which which provides operations to operate as a heap any data structure that contains the Push, Pop, Len, Less, and Swap methods.

package main

import (
    "fmt"
    "container/heap"
)

type Task struct {
    priority int
    name     string
}

type TaskPQ []Task

func (self TaskPQ) Len() int { return len(self) }
func (self TaskPQ) Less(i, j int) bool {
    return self[i].priority < self[j].priority
}
func (self TaskPQ) Swap(i, j int) { self[i], self[j] = self[j], self[i] }
func (self *TaskPQ) Push(x interface{}) { *self = append(*self, x.(Task)) }
func (self *TaskPQ) Pop() (popped interface{}) {
    popped = (*self)[len(*self)-1]
    *self = (*self)[:len(*self)-1]
    return
}

func main() {
    pq := &TaskPQ{{3, "Clear drains"},
        {4, "Feed cat"},
        {5, "Make tea"},
        {1, "Solve RC tasks"}}

    // heapify
    heap.Init(pq)

    // enqueue
    heap.Push(pq, Task{2, "Tax return"})

    for pq.Len() != 0 {
        // dequeue
        fmt.Println(heap.Pop(pq))
    }
}

output:

{1 Solve RC tasks}
{2 Tax return}
{3 Clear drains}
{4 Feed cat}
{5 Make tea}

Groovy

Groovy can use the built in java PriorityQueue class

import groovy.transform.Canonical

@Canonical
class Task implements Comparable<Task> {
    int priority
    String name
    int compareTo(Task o) { priority <=> o?.priority }
}

new PriorityQueue<Task>().with {
    add new Task(priority: 3, name: 'Clear drains')
    add new Task(priority: 4, name: 'Feed cat')
    add new Task(priority: 5, name: 'Make tea')
    add new Task(priority: 1, name: 'Solve RC tasks')
    add new Task(priority: 2, name: 'Tax return')

    while (!empty) { println remove() }
}

Output:

Task(1, Solve RC tasks)
Task(2, Tax return)
Task(3, Clear drains)
Task(4, Feed cat)
Task(5, Make tea)

Haskell

One of the best Haskell implementations of priority queues (of which there are many) is [http://hackage.haskell.org/package/pqueue pqueue], which implements a binomial heap.

import Data.PQueue.Prio.Min

main = print (toList (fromList [(3, "Clear drains"),(4, "Feed cat"),(5, "Make tea"),(1, "Solve RC tasks"), (2, "Tax return")]))

Although Haskell's standard library does not have a dedicated priority queue structure, one can (for most purposes) use the built-in Data.Set data structure as a priority queue, as long as no two elements compare equal (since Set does not allow duplicate elements). This is the case here since no two tasks should have the same name. The complexity of all basic operations is still O(log n) although that includes the "elemAt 0" function to retrieve the first element of the ordered sequence if that were required; "fromList" takes O(n log n) and "toList" takes O(n) time complexity. Alternatively, a Data.Map.Lazy or Data.Map.Strict can be used in the same way with the same limitations.

import qualified Data.Set as S

main = print (S.toList (S.fromList [(3, "Clear drains"),(4, "Feed cat"),(5, "Make tea"),(1, "Solve RC tasks"), (2, "Tax return")]))

{{out}}

[(1,"Solve RC tasks"),(2,"Tax return"),(3,"Clear drains"),(4,"Feed cat"),(5,"Make tea")]

Alternatively, a homemade min heap implementation:

data MinHeap a = Nil | MinHeap { v::a, cnt::Int, l::MinHeap a, r::MinHeap a }
  deriving (Show, Eq)

hPush :: (Ord a) => a -> MinHeap a -> MinHeap a
hPush x Nil = MinHeap {v = x, cnt = 1, l = Nil, r = Nil}
hPush x h = if x < vv -- insert element, try to keep the tree balanced
  then if hLength (l h) <= hLength (r h)
    then MinHeap { v=x, cnt=cc, l=hPush vv ll, r=rr }
    else MinHeap { v=x, cnt=cc, l=ll, r=hPush vv rr }
  else if hLength (l h) <= hLength (r h)
    then MinHeap { v=vv, cnt=cc, l=hPush x ll, r=rr }
    else MinHeap { v=vv, cnt=cc, l=ll, r=hPush x rr }
  where (vv, cc, ll, rr) = (v h, 1 + cnt h, l h, r h)

hPop :: (Ord a) => MinHeap a -> (a, MinHeap a)
hPop h = (v h, pq) where -- just pop, heed not the tree balance
  pq  | l h == Nil = r h
    | r h == Nil = l h
    | v (l h) <= v (r h) = let (vv,hh) = hPop (l h) in
      MinHeap {v = vv, cnt = hLength hh + hLength (r h),
        l = hh, r = r h}
    | otherwise = let (vv,hh) = hPop (r h) in
      MinHeap {v = vv, cnt = hLength hh + hLength (l h),
        l = l h, r = hh}

hLength :: (Ord a) => MinHeap a -> Int
hLength Nil = 0
hLength h = cnt h

hFromList :: (Ord a) => [a] -> MinHeap a
hFromList = foldl (flip hPush) Nil

hToList :: (Ord a) => MinHeap a -> [a]
hToList = unfoldr f where
  f Nil = Nothing
  f h = Just $ hPop h

main = mapM_ print $ hToList $ hFromList [
  (3, "Clear drains"),
  (4, "Feed cat"),
  (5, "Make tea"),
  (1, "Solve RC tasks"),
  (2, "Tax return")]

The above code is a Priority Queue but isn't a [https://en.wikipedia.org/wiki/Binary_heap Min Heap based on a Binary Heap] for the following reasons: 1) it does not preserve the standard tree structure of the binary heap and 2) the tree balancing can be completely destroyed by some combinations of "pop" operations. The following code is a true purely functional Min Heap implementation and as well implements the extra optional features of Min Heap's that it can build a new Min Heap from a list in O(n) amortized time rather than the O(n log n) amortized time (for a large number of randomly ordered entries) by simply using repeated "push" operations; as well as the standard "push", "peek", "delete" and "pop" (combines the previous two). As well as the "fromList", "toList", and "sort" functions (the last combines the first two), it also has an "isEmpty" function to test for the empty queue, an "adjust" function that applies a function to every entry in the queue and reheapifies in O(n) amortized time and also the "replaceMin" function which is about twice as fast on the average as combined "delete" followed by "push" operations:

data MinHeap kv = MinHeapEmpty
                  | MinHeapLeaf !kv
                  | MinHeapNode !kv {-# UNPACK #-} !Int !(MinHeap a) !(MinHeap a)
  deriving (Show, Eq)

emptyPQ :: MinHeap kv
emptyPQ = MinHeapEmpty

isEmptyPQ :: PriorityQ kv -> Bool
isEmptyPQ Mt = True
isEmptyPQ _  = False

sizePQ :: (Ord kv) => MinHeap kv -> Int
sizePQ MinHeapEmpty = 0
sizePQ (MinHeapLeaf _) = 1
sizePQ (MinHeapNode _ cnt _ _) = cnt

peekMinPQ :: MinHeap kv -> Maybe kv
peekMinPQ MinHeapEmpty = Nothing
peekMinPQ (MinHeapLeaf v) = Just v
peekMinPQ (MinHeapNode v _ _ _) = Just v

pushPQ :: (Ord kv) => kv -> MinHeap kv -> MinHeap kv
pushPQ kv pq = insert kv 0 pq where -- insert element, keeping the tree balanced
  insert kv _ MinHeapEmpty = MinHeapLeaf kv
  insert kv _ (MinHeapLeaf vv) = if kv <= vv
      then MinHeapNode kv 2 (MinHeapLeaf vv) MinHeapEmpty
      else MinHeapNode vv 2 (MinHeapLeaf kv) MinHeapEmpty
  insert kv msk (MinHeapNode vv cc ll rr) = if kv <= vv
      then if nmsk >= 0
        then MinHeapNode kv nc (insert vv nmsk ll) rr
        else MinHeapNode kv nc ll (insert vv nmsk rr)
      else if nmsk >= 0
        then MinHeapNode vv nc (insert kv nmsk ll) rr
        else MinHeapNode vv nc ll (insert kv nmsk rr)
    where nc = cc + 1
          nmsk = if msk /= 0 then msk `shiftL` 1 -- walk path to next
                 else let s = floor $ (log $ fromIntegral nc) / log 2 in
                      (nc `shiftL` ((finiteBitSize cc) - s)) .|. 1 --never 0 again

siftdown :: (Ord kv) => kv -> Int -> MinHeap kv -> MinHeap kv -> MinHeap kv
siftdown kv cnt lft rght = replace cnt lft rght where
  replace cc ll rr = case rr of -- adj to put kv in current left/right
    MinHeapEmpty -> -- means left is a MinHeapLeaf
      case ll of { (MinHeapLeaf vl) ->
        if kv <= vl
          then MinHeapNode kv 2 ll MinHeapEmpty
          else MinHeapNode vl 2 (MinHeapLeaf kv) MinHeapEmpty }
    MinHeapLeaf vr ->
      case ll of
        MinHeapLeaf vl -> if vl <= vr
          then if kv <= vl then MinHeapNode kv cc ll rr
               else MinHeapNode vl cc (MinHeapLeaf kv) rr
          else if kv <= vr then MinHeapNode kv cc ll rr
               else MinHeapNode vr cc ll (MinHeapLeaf kv)
        MinHeapNode vl ccl lll rrl -> if vl <= vr
          then if kv <= vl then MinHeapNode kv cc ll rr
               else MinHeapNode vl cc (replace ccl lll rrl) rr
          else if kv <= vr then MinHeapNode kv cc ll rr
               else MinHeapNode vr cc ll (MinHeapLeaf kv)
    MinHeapNode vr ccr llr rrr -> case ll of
      (MinHeapNode vl ccl lll rrl) -> -- right is node, so is left
        if vl <= vr then
          if kv <= vl then MinHeapNode kv cc ll rr
          else MinHeapNode vl cc (replace ccl lll rrl) rr
        else if kv <= vr then MinHeapNode kv cc ll rr
             else MinHeapNode vr cc ll (replace ccr llr rrr)

replaceMinPQ :: (Ord kv) => a -> MinHeap kv -> MinHeap kv
replaceMinPQ _ MinHeapEmpty = MinHeapEmpty
replaceMinPQ kv (MinHeapLeaf _) = MinHeapLeaf kv
replaceMinPQ kv (MinHeapNode _ cc ll rr) = siftdown kv cc ll rr where

deleteMinPQ :: (Ord kv) => MinHeap kv -> MinHeap kv
deleteMinPQ MinHeapEmpty = MinHeapEmpty -- remove min keeping tree balanced
deleteMinPQ pq = let (dkv, npq) = delete 0 pq in
                 replaceMinPQ dkv npq where
  delete _ (MinHeapLeaf vv) = (vv, MinHeapEmpty)
  delete msk (MinHeapNode vv cc ll rr) =
      if rr == MinHeapEmpty -- means left is MinHeapLeaf
        then case ll of (MinHeapLeaf vl) -> (vl, MinHeapLeaf vv)
      else if nmsk >= 0 -- means only deal with left
             then let (dv, npq) = delete nmsk ll in
                  (dv, MinHeapNode vv (cc - 1) npq rr)
             else let (dv, npq) = delete nmsk rr in
                  (dv, MinHeapNode vv (cc - 1) ll npq)
    where nmsk = if msk /= 0 then msk `shiftL` 1 -- walk path to last
                 else let s = floor $ (log $ fromIntegral cc) / log 2 in
                      (cc `shiftL` ((finiteBitSize cc) - s)) .|. 1 --never 0 again

adjustPQ :: (Ord kv) => (kv -> kv) -> MinHeap kv -> MinHeap kv
adjustPQ f pq = adjust pq where -- applies function to every element and reheapifies
  adjust MinHeapEmpty = MinHeapEmpty
  adjust (MinHeapLeaf v) = MinHeapLeaf (f v)
  adjust (MinHeapNode vv cc ll rr) = siftdown (f vv) cc (adjust ll) (adjust rr)

fromListPQ :: (Ord kv) => [kv] -> MinHeap kv
-- fromListPQ = foldl (flip pushPQ) MinHeapEmpty -- O(n log n) time; slow
fromListPQ [] = MinHeapEmpty -- O(n) time using "adjust id" which is O(n)
fromListPQ xs = let (_, pq) = build 1 xs in pq where
  sz = length xs
  szd2 = sz `div` 2
  build _ [] = ([], MinHeapEmpty)
  build lvl (x:xs') = if lvl > szd2 then (xs', MinHeapLeaf x)
                      else let nlvl = lvl + lvl in
                           let (xrl, pql) = build nlvl xs' in
                           let (xrr, pqr) = if nlvl >= sz
                                 then (xrl, MinHeapEmpty) -- no right leaf
                                 else build (nlvl + 1) xrl in
                           let cnt = sizePQ pql + sizePQ pqr + 1 in
                           (xrr, siftdown x cnt pql pqr)

popMinPQ :: (Ord kv) => MinHeap kv -> Maybe (kv, MinHeap kv)
popMinPQ pq = case peekMinPQ pq of
                Nothing -> Nothing
                Just v -> Just (v, deleteMinPQ pq)

toListPQ :: (Ord kv) => MinHeap kv -> [kv]
toListPQ = unfoldr f where
  f MinHeapEmpty = Nothing
  f pq = popMinPQ pq

sortPQ :: (Ord kv) => [kv] -> [kv]
sortPQ ls = toListPQ $ fromListPQ ls

If one is willing to forgo the fast O(1) "size" function and to give up strict conformance to the Heap tree structure (where rather than building each new level until each left node is full to that level before increasing level to the right, a new level is built by promoting leaves to branches only containing left leaves until all branches have left leaves before filling any right leaves of that level) although having even better tree balancing and therefore at least as high efficiency, one can use the following code adapted from the [http://www.cl.cam.ac.uk/~lp15/MLbook/programs/sample4.sml ''ML'' PRIORITY_QUEUE code by Lawrence C. Paulson] including separating the key/value pairs as separate entries in the data structure for better comparison efficiency; as noted in the code comments, a "size" function to output the number of elements in the queue (fairly quickly in O((log n)^2)), an "adjust" function to apply a function to all elements and reheapify in O(n) time, and a "merge" function to merge two queues has been added to the ML code:

data PriorityQ k v = Mt
                     | Br !k v !(PriorityQ k v) !(PriorityQ k v)
  deriving (Eq, Ord, Read, Show)

emptyPQ :: PriorityQ k v
emptyPQ = Mt

isEmptyPQ :: PriorityQ k v -> Bool
isEmptyPQ Mt = True
isEmptyPQ _  = False

-- The size function isn't from the ML code, but an implementation was
-- suggested by Bertram Felgenhauer on Haskell Cafe, so it is included.

-- Return number of elements in the priority queue.
-- /O(log(n)^2)/
sizePQ :: PriorityQ k v -> Int
sizePQ Mt = 0
sizePQ (Br _ _ pl pr) = 2 * n + rest n pl pr where
  n = sizePQ pr
  -- rest n p q, where n = sizePQ q, and sizePQ p - sizePQ q = 0 or 1
  -- returns 1 + sizePQ p - sizePQ q.
  rest :: Int -> PriorityQ k v -> PriorityQ k v -> Int
  rest 0 Mt _ = 1
  rest 0 _  _ = 2
  rest n (Br _ _ ll lr) (Br _ _ rl rr) = case r of
      0 -> rest d ll rl -- subtree sizes: (d or d+1), d; d, d
      1 -> rest d lr rr -- subtree sizes: d+1, (d or d+1); d+1, d
    where m1 = n - 1
          d = m1 `shiftR` 1
          r = m1 .&. 1

peekMinPQ :: PriorityQ k v -> Maybe (k, v)
peekMinPQ Mt           = Nothing
peekMinPQ (Br k v _ _) = Just (k, v)

pushPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
pushPQ wk wv Mt           = Br wk wv Mt Mt
pushPQ wk wv (Br vk vv pl pr)
             | wk <= vk   = Br wk wv (pushPQ vk vv pr) pl
             | otherwise  = Br vk vv (pushPQ wk wv pr) pl

siftdown :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v -> PriorityQ k v
siftdown wk wv Mt _          = Br wk wv Mt Mt
siftdown wk wv (pl @ (Br vk vv _ _)) Mt
    | wk <= vk               = Br wk wv pl Mt
    | otherwise              = Br vk vv (Br wk wv Mt Mt) Mt
siftdown wk wv (pl @ (Br vkl vvl pll plr)) (pr @ (Br vkr vvr prl prr))
    | wk <= vkl && wk <= vkr = Br wk wv pl pr
    | vkl <= vkr             = Br vkl vvl (siftdown wk wv pll plr) pr
    | otherwise              = Br vkr vvr pl (siftdown wk wv prl prr)

replaceMinPQ :: Ord k => k -> v -> PriorityQ k v -> PriorityQ k v
replaceMinPQ wk wv Mt             = Mt
replaceMinPQ wk wv (Br _ _ pl pr) = siftdown wk wv pl pr

deleteMinPQ :: (Ord k) =>  PriorityQ k v -> PriorityQ k v
deleteMinPQ Mt             = Mt
deleteMinPQ (Br _ _ pr Mt) = pr
deleteMinPQ (Br _ _ pl pr) = let (k, v, npl) = leftrem pl in
                             siftdown k v pr npl where
  leftrem (Br k v Mt Mt)             = (k, v, Mt)
  leftrem (Br vk vv (Br k v _ _) Mt) = (k, v, Br vk vv Mt Mt)
  leftrem (Br vk vv pl pr)           = let (k, v, npl) = leftrem pl in
                                       (k, v, Br vk vv pr npl)

-- the following function has been added to the ML code to apply a function
--   to all the entries in the queue and reheapify in O(n) time
adjustPQ :: (Ord k) => (k -> v -> (k, v)) -> PriorityQ k v -> PriorityQ k v
adjustPQ f pq = adjust pq where -- applies function to every element and reheapifies
  adjust Mt               = Mt
  adjust (Br vk vv pl pr) = let (k, v) = f vk vv in
                            siftdown k v (adjust pl) (adjust pr)

fromListPQ :: (Ord k) => [(k, v)] -> PriorityQ k v
-- fromListPQ = foldl (flip pushPQ) Mt -- O(n log n) time; slow
fromListPQ [] = Mt -- O(n) time using adjust-from-bottom which is O(n)
fromListPQ xs = let (pq, _) = build (length xs) xs in pq where
  build 0 xs             = (Mt, xs)
  build lvl ((k, v):xs') = let (pl, xrl) = build (lvl `shiftR` 1) xs'
                               (pr, xrr) = build ((lvl - 1) `shiftR` 1) xrl in
                           (siftdown k v pl pr, xrr)

-- the following function has been added to merge two queues in O(m + n) time
--   where m and n are the sizes of the two queues
mergePQ :: (Ord k) => PriorityQ k v -> PriorityQ k v -> PriorityQ k v
mergePQ pq1 Mt = pq1 -- from concatenated "dumb" list
mergePQ Mt pq2 = pq2 -- in O(m + n) time where m,n are sizes pq1,pq2
mergePQ pq1 pq2 = fromListPQ (zipper pq1 $ zipper pq2 []) where
  zipper (Br wk wv Mt _) appndlst  = (wk, wv) : appndlst
  zipper (Br wk wv pl Mt) appndlst = (wk, wv) : zipper pl appndlst
  zipper (Br wk wv pl pr) appndlst = (wk, wv) : zipper pl (zipper pr appndlst)

popMinPQ :: (Ord k) => PriorityQ k v -> Maybe ((k, v), PriorityQ k v)
popMinPQ pq = case peekMinPQ pq of
                Nothing -> Nothing
                Just kv -> Just (kv, deleteMinPQ pq)

toListPQ :: (Ord k) => PriorityQ k v -> [(k, v)]
toListPQ Mt                  = [] -- unfoldr popMinPQ
toListPQ pq @ (Br vk vv _ _) = (vk, vv) : (toListPQ $ deleteMinPQ pq)

sortPQ :: (Ord k) => [(k, v)] -> [(k, v)]
sortPQ ls = toListPQ $ fromListPQ ls

The above codes compile but do not run with GHC Haskell version 7.8.3 using the LLVM back end with LLVM version 3.4 and full optimization turned on under Windows 32; they were tested under Windows 64 and 32 using the Native Code Generator back end with full optimization. With GHC Haskell version 7.10.1 they compile and run with or without LLVM 3.5.1 for 32-bit Windows (64-bit GHC Haskell under Windows does not run with LLVM for version 7.10.1), with a slight execution speed advantage to using LLVM.

Min Heaps are faster than Priority Queue's based on Binomial Heaps (or Leftist or Skewed Heaps) when one mainly requires fast replacement of the head of the queue without many fresh "push" operations; Binomial Heap based versions (or Leftist or Skewed Heap based versions) are faster for merging of a series of large queues into one and for algorithms that have a lot of "push" operations of random entries. Both have O(log n) average "push" and "pop" time complexity with O(1) for "peek", but Binomial Heap based queues (and the others) tend to be somewhat slower by a constant factor due to more complex operations.

Min Heaps are also faster than the use of balanced tree Set's or Map's where many references are made to the next element in the queue (O(1) complexity rather than O(log n)) or where frequent modification and reinsertion of the next element in the queue is required (still O(log n) but faster by a constant factor greater than two on average) and generally faster by a constant factor as operations near the top of the queue don't have to traverse the entire tree structure; O(log n) is worst case time complexity for "replace" operations not average.

The above codes when tested with the following "main" function (with a slight modification for the first test when the combined kv entry is used):

testList = [ (3, "Clear drains"),
             (4, "Feed cat"),
             (5, "Make tea"),
             (1, "Solve RC tasks"),
             (2, "Tax return") ]

testPQ = fromListPQ testList

main = do -- slow build
  mapM_ print $ toListPQ $ foldl (\pq (k, v) -> pushPQ k v pq) emptyPQ testList
  putStrLn "" -- fast build
  mapM_ print $ toListPQ $ fromListPQ testList
  putStrLn "" -- combined fast sort
  mapM_ print $ sortPQ testList
  putStrLn "" -- test merge
  mapM_ print $ toListPQ $ mergePQ testPQ testPQ
  putStrLn "" -- test adjust
  mapM_ print $ toListPQ $ adjustPQ (\x y -> (x * (-1), y)) testPQ

has the output as follows: {{output}}

(1,"Solve RC tasks")
(2,"Tax return")
(3,"Clear drains")
(4,"Feed cat")
(5,"Make tea")

(1,"Solve RC tasks")
(2,"Tax return")
(3,"Clear drains")
(4,"Feed cat")
(5,"Make tea")

(1,"Solve RC tasks")
(2,"Tax return")
(3,"Clear drains")
(4,"Feed cat")
(5,"Make tea")

(1,"Solve RC tasks")
(1,"Solve RC tasks")
(2,"Tax return")
(2,"Tax return")
(3,"Clear drains")
(3,"Clear drains")
(4,"Feed cat")
(4,"Feed cat")
(5,"Make tea")
(5,"Make tea")

(-5,"Make tea")
(-4,"Feed cat")
(-3,"Clear drains")
(-2,"Tax return")
(-1,"Solve RC tasks")

but the first method uses the slower way of building a queue.

=={{header|Icon}} and {{header|Unicon}}== This solution uses classes provided by the UniLib package. Heap is an implementation of a priority queue and Closure is used to allow the queue to order lists based on their first element. The solution only works in Unicon.

import Utils   # For Closure class
import Collections      # For Heap (dense priority queue) class

procedure main()
   pq := Heap(, Closure("[]",Arg,1) )
   pq.add([3, "Clear drains"])
   pq.add([4, "Feed cat"])
   pq.add([5, "Make tea"])
   pq.add([1, "Solve RC tasks"])
   pq.add([2, "Tax return"])

   while task := pq.get() do write(task[1]," -> ",task[2])
end

Output when run:

1 -> Solve RC tasks
2 -> Tax return
3 -> Clear drains
4 -> Feed cat
5 -> Make tea

J

Implementation:

coclass 'priorityQueue'

PRI=: ''
QUE=: ''

insert=:4 :0
  p=. PRI,x
  q=. QUE,y
  assert. p -:&$ q
  assert. 1 = #$q
  ord=: \: p
  QUE=: ord { q
  PRI=: ord { p
  i.0 0
)

topN=:3 :0
  assert y<:#PRI
  r=. y{.QUE
  PRI=: y}.PRI
  QUE=: y}.QUE
  r
)

Efficiency is obtained by batching requests. Size of batch for insert is determined by size of arguments. Size of batch for topN is its right argument.

Example:

   Q=: conew'priorityQueue'
   3 4 5 1 2 insert__Q 'clear drains';'feed cat';'make tea';'solve rc task';'tax return'
   >topN__Q 1
make tea
   >topN__Q 4
feed cat
clear drains
tax return
solve rc task

Java

Java has a PriorityQueue class. It requires either the elements implement Comparable, or you give it a custom Comparator to compare the elements.

import java.util.PriorityQueue;

class Task implements Comparable<Task> {
    final int priority;
    final String name;

    public Task(int p, String n) {
        priority = p;
        name = n;
    }

    public String toString() {
        return priority + ", " + name;
    }

    public int compareTo(Task other) {
        return priority < other.priority ? -1 : priority > other.priority ? 1 : 0;
    }

    public static void main(String[] args) {
        PriorityQueue<Task> pq = new PriorityQueue<Task>();
        pq.add(new Task(3, "Clear drains"));
        pq.add(new Task(4, "Feed cat"));
        pq.add(new Task(5, "Make tea"));
        pq.add(new Task(1, "Solve RC tasks"));
        pq.add(new Task(2, "Tax return"));

        while (!pq.isEmpty())
            System.out.println(pq.remove());
    }
}

{{out}}

1, Solve RC tasks
2, Tax return
3, Clear drains
4, Feed cat
5, Make tea

jq

Since jq is a functional language, the priority queue must be represented explicitly as data; in the following, we use a JSON object with keys as priorities (strings). Since a given priority level may have more than task, we use arrays to hold the values.

The special key "priorities" is used to store the priorities in a sorted array. Since "sort" is fast we will use that rather than optimizing insertion in the priorities array.

We assume that if an item of a given priority is already in the priority queue, there is no need to add it again.

# In the following, pq stands for "priority queue".

# Add an item with the given priority (an integer,
# or a string representing an integer)
# Input: a pq
def pq_add(priority; item):
  (priority|tostring) as $p
  | if .priorities|index($p) then
      if (.[$p] | index(item)) then . else .[$p] += [item] end
    else .[$p] = [item] | .priorities = (.priorities + [$p] | sort)
    end ;

# emit [ item, pq ]
# Input: a pq
def pq_pop:
  .priorities as $keys
  | if ($keys|length) == 0 then [ null, . ]
    else
      if (.[$keys[0]] | length) == 1
      then .priorities =  .priorities[1:]
      else .
      end
      | [ (.[$keys[0]])[0], (.[$keys[0]] = .[$keys[0]][1:]) ]
    end ;

# Emit the item that would be popped, or null if there is none
# Input: a pq
def pq_peep:
  .priorities as $keys
  | if ($keys|length) == 0 then null
    else (.[$keys[0]])[0]
    end ;

# Add a bunch of tasks, presented as an array of arrays
# Input: a pq
def pq_add_tasks(list):
  reduce list[] as $pair (.; . + pq_add( $pair[0]; $pair[1]) ) ;

# Pop all the tasks, producing a stream
# Input: a pq
def pq_pop_tasks:
  pq_pop as $pair
  | if $pair[0] == null then empty
    else $pair[0], ( $pair[1] | pq_pop_tasks )
    end ;

# Input: a bunch of tasks, presented as an array of arrays
def prioritize:
  . as $list | {} | pq_add_tasks($list) | pq_pop_tasks ;

The specific task:

[ [3,     "Clear drains"],
  [4,     "Feed cat"],
  [5,     "Make tea"],
  [1,     "Solve RC tasks"],
  [2,     "Tax return"]
 ] | prioritize

{{Out}} "Solve RC tasks" "Tax return" "Clear drains" "Feed cat" "Make tea"

Julia

Julia has built-in support for priority queues, though the PriorityQueue type is not exported by default. Priority queues are a specialization of the Dictionary type having ordered values, which serve as the priority. In addition to all of the methods of standard dictionaries, priority queues support: enqueue!, which adds an item to the queue, dequeue! which removes the lowest priority item from the queue, returning its key, and peek, which returns the (key, priority) of the lowest priority entry in the queue. The ordering behavior of the queue, which by default is its value sort order (typically low to high), can be set by passing an order directive to its constructor. For this task, Base.Order.Reverse is used to set-up the task queue to return tasks from high to low priority.

using Base.Collections

test = ["Clear drains" 3;
        "Feed cat" 4;
        "Make tea" 5;
        "Solve RC tasks" 1;
        "Tax return" 2]

task = PriorityQueue(Base.Order.Reverse)
for i in 1:size(test)[1]
    enqueue!(task, test[i,1], test[i,2])
end

println("Tasks, completed according to priority:")
while !isempty(task)
    (t, p) = peek(task)
    dequeue!(task)
    println("    \"", t, "\" has priority ", p)
end

{{out}}

Tasks, completed according to priority:
    "Make tea" has priority 5
    "Feed cat" has priority 4
    "Clear drains" has priority 3
    "Tax return" has priority 2
    "Solve RC tasks" has priority 1

Kotlin

{{trans|Java}}

import java.util.PriorityQueue

internal data class Task(val priority: Int, val name: String) : Comparable<Task> {
    override fun compareTo(other: Task) = when {
        priority < other.priority -> -1
        priority > other.priority -> 1
        else -> 0
    }
}

private infix fun String.priority(priority: Int) = Task(priority, this)

fun main(args: Array<String>) {
    val q = PriorityQueue(listOf("Clear drains" priority 3,
                                 "Feed cat" priority 4,
                                 "Make tea" priority 5,
                                 "Solve RC tasks" priority 1,
                                 "Tax return" priority 2))
    while (q.any()) println(q.remove())
}

{{out}}

Task(priority=1, name=Solve RC tasks)
Task(priority=2, name=Tax return)
Task(priority=3, name=Clear drains)
Task(priority=4, name=Feed cat)
Task(priority=5, name=Make tea)

Lasso

 type {
    data
        store        = map,
        cur_priority = void

    public push(priority::integer, value) => {
        local(store) = .`store`->find(#priority)

        if(#store->isA(::array)) => {
            #store->insert(#value)
            return
        }
        .`store`->insert(#priority=array(#value))

        .`cur_priority`->isA(::void) or #priority < .`cur_priority`
            ? .`cur_priority` = #priority
    }

    public pop => {
        .`cur_priority` == void
            ? return void

        local(store)  = .`store`->find(.`cur_priority`)
        local(retVal) =  #store->first

        #store->removeFirst&size > 0
            ? return #retVal

        // Need to find next priority
        .`store`->remove(.`cur_priority`)

        if(.`store`->size == 0) => {
            .`cur_priority` = void
        else
            // There are better / faster ways to do this
            // The keys are actually already sorted, but the order of
            // storage in a map is not actually defined, can't rely on it
            .`cur_priority` = .`store`->keys->asArray->sort&first
        }

        return #retVal
    }

    public isEmpty => (.`store`->size == 0)

}

local(test) = priorityQueue

#test->push(2,`e`)
#test->push(1,`H`)
#test->push(5,`o`)
#test->push(2,`l`)
#test->push(5,`!`)
#test->push(4,`l`)

while(not #test->isEmpty) => {
    stdout(#test->pop)
}

{{out}}

Hello!

Lua

This implementation uses a table with priorities as keys and queues as values. Queues for each priority are created when putting items as needed and are shrunk as necessary when popping items and removed when they are empty. Instead of using a plain array table for each queue, the technique shown in the Lua implementation from the [[Queue/Definition#Lua | Queue]] task is used. This avoids having to use table.remove(t, 1) to get and remove the first queue element, which is rather slow for big tables.

PriorityQueue = {
    __index = {
        put = function(self, p, v)
            local q = self[p]
            if not q then
                q = {first = 1, last = 0}
                self[p] = q
            end
            q.last = q.last + 1
            q[q.last] = v
        end,
        pop = function(self)
            for p, q in pairs(self) do
                if q.first <= q.last then
                    local v = q[q.first]
                    q[q.first] = nil
                    q.first = q.first + 1
                    return p, v
                else
                    self[p] = nil
                end
            end
        end
    },
    __call = function(cls)
        return setmetatable({}, cls)
    end
}

setmetatable(PriorityQueue, PriorityQueue)

-- Usage:
pq = PriorityQueue()

tasks = {
    {3, 'Clear drains'},
    {4, 'Feed cat'},
    {5, 'Make tea'},
    {1, 'Solve RC tasks'},
    {2, 'Tax return'}
}

for _, task in ipairs(tasks) do
    print(string.format("Putting: %d - %s", unpack(task)))
    pq:put(unpack(task))
end

for prio, task in pq.pop, pq do
    print(string.format("Popped: %d - %s", prio, task))
end

'''Output:'''

Putting: 3 - Clear drains
Putting: 4 - Feed cat
Putting: 5 - Make tea
Putting: 1 - Solve RC tasks
Putting: 2 - Tax return
Popped: 1 - Solve RC tasks
Popped: 2 - Tax return
Popped: 3 - Clear drains
Popped: 4 - Feed cat
Popped: 5 - Make tea

The implementation is faster than the Python implementations below using queue.PriorityQueue or heapq, even when comparing the standard Lua implementation against [[PyPy]] and millions of tasks are added to the queue. With LuaJIT it is yet faster. The following code measures the time needed to add 10⁷ tasks with a random priority between 1 and 1000 and to retrieve them from the queue again in order.

-- Use socket.gettime() for benchmark measurements
-- since it has millisecond precision on most systems
local socket = require("socket")

n = 10000000 -- number of tasks added (10^7)
m = 1000     -- number different priorities

local pq = PriorityQueue()

print(string.format("Adding %d tasks with random priority 1-%d ...", n, m))
start = socket.gettime()

for i = 1, n do
    pq:put(math.random(m), i)
end

print(string.format("Elapsed: %.3f ms.", (socket.gettime() - start) * 1000))

print("Retrieving all tasks in order...")
start = socket.gettime()

local pp = 0
local pv = 0

for i = 1, n do
    local p, task = pq:pop()

    -- check that tasks are popped in ascending priority
    assert(p >= pp)

    if pp == p then
        -- check that tasks within one priority maintain the insertion order
        assert(task > pt)
    end

    pp = p
    pt = task
end

print(string.format("Elapsed: %.3f ms.", (socket.gettime() - start) * 1000))

M2000 Interpreter

For these three examples, we can use same priorities, so if a priority exist then the new insertion not alter the top item (which we pop or peek from queue).

Using unordered array

Module UnOrderedArray {
      Class PriorityQueue {
      Private:
            Dim Item()
            many=0, level=0, first
            cmp = lambda->0
            Module Reduce {
                  if .many<.first*2 then exit
                  If .level<.many/2 then .many/=2 : Dim .Item(.many)
            }
      Public:
            Module Clear {
              Dim .Item() \\ erase all
              .many<=0 \\ default
              .Level<=0
            }
            Module PriorityQueue {
                  If .many>0 then Error "Clear List First"
                  Read .many, .cmp
                  .first<=.many
                  Dim .Item(.many)
            }
            Module Add {
                 If .level=.many Then {
                       If .many=0 then Error "Define Size First"
                        Dim .Item(.many*2)
                        .many*=2
                 }
                 Read Item
                 If .level=0 Then {
                       .Item(0)=Item
                 } Else.if .cmp(.Item(0), Item)=-1 Then { \\ Item is max
                       .Item(.level)=Item
                       swap .Item(0), .Item(.level)
                 } Else .Item(.level)=Item
                 .level++
            }
            Function Peek {
                  If .level=0 Then error "empty"
                  =.Item(0)
            }
            Function Poll {
                  If .level=0 Then error "empty"
                  =.Item(0)
                  If .level=2 Then {
                  swap .Item(0), .Item(1)
                  .Item(1)=0
                  .Level<=1
                  } Else.If .level>2 Then {
                        .Level--
                        Swap .Item(.level), .Item(0)
                        .Item(.level)=0
                        For I=.level-1 to 1 {
                              If .cmp(.Item(I), .Item(I-1))=1 Then Swap .Item(I), .Item(I-1)
                        }
                  } else .level<=0 : .Item(0)=0
                  .Reduce
            }
            Module Remove {
                  If .level=0 Then error "empty"
                  Read Item
                  k=true
                  If .cmp(.Item(0), Item)=0 Then {
                        Item=.Poll()
                        K~  \\ k=false
                  } Else.If .Level>1 Then {
                        I2=.Level-1
                            For I=1 to I2 {
                                    If k Then {
                                           If .cmp(.Item(I), Item)=0 Then {
                                                 If I<I2 Then Swap .Item(I), .Item(I2)
                                                 .Item(I2)=0
                                                 k=false
                                           }
                                    } else exit
                              }
                       .Level--
                  }
                  If k Then Error "Not Found"
                  .Reduce
            }
            Function Size {
                  If .many=0 then Error "Define Size First"
                  =.Level
            }
      }

      Class Item { X, S$
            Module Item { Read .X, .S$}
      }
      Function PrintTop {
            M=Queue.Peek() : Print "Item ";M.X, M.S$
      }
      Comp=Lambda -> { Read A,B : =COMPARE(A.X,B.X)}

      Queue=PriorityQueue(100,Comp)
      Queue.Add Item(3, "Clear drains")
      Call Local PrintTop()
      Queue.Add Item(4  ,"Feed cat")
      Call Local PrintTop()
      Queue.Add Item(5  ,"Make tea")
      Call Local PrintTop()
      Queue.Add Item(1  ,"Solve RC tasks")
      Call Local PrintTop()
      Queue.Add Item(2  ,"Tax return")
      Call Local PrintTop()
      Print "remove items"
      While true {
            MM=Queue.Poll()
            Print MM.X, MM.S$
            Print "Size="; Queue.Size()
            If Queue.Size()=0 Then exit
            Call Local PrintTop()
      }
}
UnOrderedArray

Using a stack with arrays as elements

Every insertion push item using binary search in proper position. Pop is very fast.

Module PriorityQueue {
      a= ( (3, "Clear drains"), (4 ,"Feed cat"), ( 5 , "Make tea"), ( 1 ,"Solve RC tasks"), ( 2 , "Tax return"))
      b=stack
      comp=lambda (a, b) ->{
            =array(a, 0)<array(b, 0)
      }
      module InsertPQ (a, n, &comp) {
            if len(a)=0 then stack a {data n} : exit
            if comp(n, stackitem(a)) then stack a {push n} : exit
             stack a {
                  push n
                  t=2: b=len(a)
                   m=b
                   while t<=b {
                         t1=m
                        m=(b+t) div 2
                        if m=0 then  m=t1 : exit
                        If comp(stackitem(m),n) then t=m+1:  continue
                        b=m-1
                        m=b
                  }
                  if m>1 then shiftback m
            }
      }

      n=each(a)
      while n {
            InsertPq b, array(n), &comp
      }

      n1=each(b)
      while n1 {
            m=stackitem(n1)
            Print array(m, 0), array$(m, 1)
      }

      \\ Peek topitem (without popping)
      Print Array$(stackitem(b), 1)
      \\ Pop item
      Stack b {
            Read old
      }
      Print Array$(old, 1)
      Function Peek$(a) {=Array$(stackitem(a), 1)}
      Function Pop$(a) {
            stack a {
                  =Array$(stackitem(), 1)
                   drop
            }
      }
      Print Peek$(b)
      Print Pop$(b)
      Function IsEmpty(a) {
        =len(a)=0
      }
      While not IsEmpty(b) {
            Print pop$(b)
      }
}
PriorityQueue

Using a stack with Groups as elements

This is the same as previous but now we use a group (a user object for M2000). InsertPQ is the same as before. Lambda comp has change only. We didn't use pointers to groups. All groups here works as values, so when we get a peek we get a copy of group in top position. All members of a group may not values, so if we have a pointer to group then we get a copy of that pointer, but then we can make changes and that changes happen for the group which we get the copy.

Module PriorityQueueForGroups {
      class obj {
            x, s$
            class:
            module obj (.x, .s$) {}
      }
      Flush  ' empty current stack
      Data obj(3, "Clear drains"), obj(4 ,"Feed cat"), obj( 5 , "Make tea"), obj( 1 ,"Solve RC tasks"), obj( 2 , "Tax return")
      b=stack
      comp=lambda (a, b) ->{
                  =a.x<b.x
      }
      module InsertPQ (a, n, &comp) {
            if len(a)=0 then stack a {data n} : exit
            if comp(n, stackitem(a)) then stack a {push n} : exit
             stack a {
                  push n
                  t=2: b=len(a)
                   m=b
                   while t<=b {
                         t1=m
                        m=(b+t) div 2
                        if m=0 then  m=t1 : exit
                        If comp(stackitem(m),n) then t=m+1:  continue
                        b=m-1
                        m=b
                  }
                  if m>1 then shiftback m
            }
      }
      b=stack
      While not empty {
            InsertPQ b, Group, &comp    ' Group pop a group from current stack
      }
       n1=each(b)
      while n1 {
            m=stackitem(n1)
            Print m.x, m.s$
      }
      Function Peek$(a) {m=stackitem(a) : =m.s$}
      Print Peek$(b)

      Function Pop$(a) {
            stack a {
                  m=stackitem()
                  =m.s$
                   drop
            }
      }
      Function IsEmpty(a) {
              =len(a)=0
      }
      While not isEmpty(b) {
            Print Pop$(b)
      }
}
PriorityQueueForGroups

Mathematica

push = Function[{queue, priority, item},
   queue = SortBy[Append[queue, {priority, item}], First], HoldFirst];
pop = Function[queue,
   If[Length@queue == 0, Null,
    With[{item = queue[[-1, 2]]}, queue = Most@queue; item]],
   HoldFirst];
peek = Function[queue,
   If[Length@queue == 0, Null, Max[queue[[All, 1]]]], HoldFirst];
merge = Function[{queue1, queue2},
   SortBy[Join[queue1, queue2], First], HoldAll];

Example:

queue = {};
push[queue, 3, "Clear drains"];
push[queue, 4, "Feed cat"];
push[queue, 5, "Make tea"];
push[queue, 1, "Solve RC tasks"];
push[queue, 2, "Tax return"];
Print[peek[queue]];
Print[pop[queue]];
queue1 = {};
push[queue1, 6, "Drink tea"];
Print[merge[queue, queue1]];

Output:

5

Make tea

{{1,Solve RC tasks},{2,Tax return},{3,Clear drains},{4,Feed cat},{6,Drink tea}}

Maxima

/* Naive implementation using a sorted list of pairs [key, [item[1], ..., item[n]]].
The key may be any number (integer or not). Items are extracted in FIFO order. */

defstruct(pqueue(q = []))$

/* Binary search */

find_key(q, p) := block(
   [i: 1, j: length(q), k, c],
   if j = 0 then false
   elseif (c: q[i][1]) >= p then
      (if c = p then i else false)
   elseif (c: q[j][1]) <= p then
      (if c = p then j else false)
   else catch(
      while j >= i do (
         k: quotient(i + j, 2),
         if (c: q[k][1]) = p then throw(k)
         elseif c < p then i: k + 1 else j: k - 1
      ),
      false
   )
)$

pqueue_push(pq, x, p) := block(
   [q: pq@q, k],
   k: find_key(q, p),
   if integerp(k) then q[k][2]: endcons(x, q[k][2])
   else pq@q: sort(cons([p, [x]], q)),
   'done
)$

pqueue_pop(pq) := block(
   [q: pq@q, v, x],
   if emptyp(q) then 'fail else (
      p: q[1][1],
      v: q[1][2],
      x: v[1],
      if length(v) > 1 then q[1][2]: rest(v) else pq@q: rest(q),
      x
   )
)$

pqueue_print(pq) := block([t], while (t: pqueue_pop(pq)) # 'fail do disp(t))$


/* An example */

a: new(pqueue)$

pqueue_push(a, "take milk", 4)$
pqueue_push(a, "take eggs", 4)$
pqueue_push(a, "take wheat flour", 4)$
pqueue_push(a, "take salt", 4)$
pqueue_push(a, "take oil", 4)$
pqueue_push(a, "carry out crepe recipe", 5)$
pqueue_push(a, "savour !", 6)$
pqueue_push(a, "add strawberry jam", 5 + 1/2)$
pqueue_push(a, "call friends", 5 + 2/3)$
pqueue_push(a, "go to the supermarket and buy food", 3)$
pqueue_push(a, "take a shower", 2)$
pqueue_push(a, "get dressed", 2)$
pqueue_push(a, "wake up", 1)$
pqueue_push(a, "serve cider", 5 + 3/4)$
pqueue_push(a, "buy also cider", 3)$

pqueue_print(a);
"wake up"
"take a shower"
"get dressed"
"go to the supermarket and buy food"
"buy also cider"
"take milk"
"take butter"
"take flour"
"take salt"
"take oil"
"carry out recipe"
"add strawberry jam"
"call friends"
"serve cider"
"savour !"

Mercury

Mercury comes with an efficient, albeit simple, priority queue in its standard library. The build_pqueue/2 predicate in the code below inserts the test data in arbitrary order. display_pqueue/3, in turn, removes one K/V pair at a time, displaying the value. Compiling and running the supplied program results in all tasks being displayed in priority order as expected.

:- module test_pqueue.

:- interface.

:- import_module io.

:- pred main(io::di, io::uo) is det.

:- implementation.

:- import_module int.
:- import_module list.
:- import_module pqueue.
:- import_module string.

:- pred build_pqueue(pqueue(int,string)::in, pqueue(int,string)::out) is det.
build_pqueue(!PQ) :-
  pqueue.insert(3, "Clear drains",   !PQ),
  pqueue.insert(4, "Feed cat",       !PQ),
  pqueue.insert(5, "Make tea",       !PQ),
  pqueue.insert(1, "Solve RC tasks", !PQ),
  pqueue.insert(2, "Tax return",     !PQ).

:- pred display_pqueue(pqueue(int, string)::in, io::di, io::uo) is det.
display_pqueue(PQ, !IO) :-
  ( pqueue.remove(K, V, PQ, PQO) ->
      io.format("Key = %d, Value = %s\n", [i(K), s(V)], !IO),
      display_pqueue(PQO, !IO)
  ;
      true
  ).

main(!IO) :-
  build_pqueue(pqueue.init, PQO),
  display_pqueue(PQO, !IO).

Nim

{{trans|C}}

type
  PriElem[T] = tuple
    data: T
    pri: int

  PriQueue[T] = object
    buf: seq[PriElem[T]]
    count: int

# first element not used to simplify indices
proc initPriQueue[T](initialSize = 4): PriQueue[T] =
  result.buf.newSeq(initialSize)
  result.buf.setLen(1)
  result.count = 0

proc add[T](q: var PriQueue[T], data: T, pri: int) =
  var n = q.buf.len
  var m = n div 2
  q.buf.setLen(n + 1)

  # append at end, then up heap
  while m > 0 and pri < q.buf[m].pri:
    q.buf[n] = q.buf[m]
    n = m
    m = m div 2

  q.buf[n] = (data, pri)
  q.count = q.buf.len - 1

proc pop[T](q: var PriQueue[T]): PriElem[T] =
  assert q.buf.len > 1
  result = q.buf[1]

  var qn = q.buf.len - 1
  var n = 1
  var m = 2
  while m < qn:
    if m + 1 < qn and q.buf[m].pri > q.buf[m+1].pri:
      inc m

    if q.buf[qn].pri <= q.buf[m].pri:
      break

    q.buf[n] = q.buf[m]
    n = m
    m = m * 2

  q.buf[n] = q.buf[qn]
  q.buf.setLen(q.buf.len - 1)
  q.count = q.buf.len - 1

var p = initPriQueue[string]()
p.add("Clear drains", 3)
p.add("Feed cat", 4)
p.add("Make tea", 5)
p.add("Solve RC tasks", 1)
p.add("Tax return", 2)

while p.count > 0:
  echo p.pop()

{{out}}

(data: Solve RC tasks, pri: 1)
(data: Tax return, pri: 2)
(data: Clear drains, pri: 3)
(data: Feed cat, pri: 4)
(data: Make tea, pri: 5)

''' Using Nim HeapQueue'''

import HeapQueue

var pq = newHeapQueue[(int, string)]()

pq.push((3, "Clear drains"))
pq.push((4, "Feed cat"))
pq.push((5, "Make tea"))
pq.push((1, "Solve RC tasks"))
pq.push((2, "Tax return"))

while pq.len() > 0:
    echo pq.pop()

{{out}}

(Field0: 1, Field1: "Solve RC tasks")
(Field0: 2, Field1: "Tax return")
(Field0: 3, Field1: "Clear drains")
(Field0: 4, Field1: "Feed cat")
(Field0: 5, Field1: "Make tea")

''' Using Nim tables'''

import tables

var
  pq = initTable[int, string]()

proc main() =
  pq.add(3, "Clear drains")
  pq.add(4, "Feed cat")
  pq.add(5, "Make tea")
  pq.add(1, "Solve RC tasks")
  pq.add(2, "Tax return")

  for i in countUp(1,5):
    if pq.hasKey(i):
      echo i, ": ", pq[i]
      pq.del(i)

main()

{{out}}

1: Solve RC tasks
2: Tax return
3: Clear drains
4: Feed cat
5: Make tea

=={{header|Objective-C}}== {{works with|Cocoa}} The priority queue used in this example is not actually written in Objective-C. It is part of Apple's (C-based) Core Foundation library, which is included with in Cocoa on Mac OS X and iOS. Its interface is a C function interface, which makes the code very ugly. Core Foundation is not included in GNUStep or other Objective-C APIs.

const void *PQRetain(CFAllocatorRef allocator, const void *ptr) {
  return (__bridge_retained const void *)(__bridge id)ptr;
}
void PQRelease(CFAllocatorRef allocator, const void *ptr) {
  (void)(__bridge_transfer id)ptr;
}
CFComparisonResult PQCompare(const void *ptr1, const void *ptr2, void *unused) {
  return [(__bridge id)ptr1 compare:(__bridge id)ptr2];
}

@interface Task : NSObject {
  int priority;
  NSString *name;
}
- (instancetype)initWithPriority:(int)p andName:(NSString *)n;
- (NSComparisonResult)compare:(Task *)other;
@end

@implementation Task
- (instancetype)initWithPriority:(int)p andName:(NSString *)n {
  if ((self = [super init])) {
    priority = p;
    name = [n copy];
  }
  return self;
}
- (NSString *)description {
  return [NSString stringWithFormat:@"%d, %@", priority, name];
}
- (NSComparisonResult)compare:(Task *)other {
  if (priority == other->priority)
    return NSOrderedSame;
  else if (priority < other->priority)
    return NSOrderedAscending;
  else
    return NSOrderedDescending;
}
@end

int main (int argc, const char *argv[]) {
  @autoreleasepool {

    CFBinaryHeapCallBacks callBacks = {0, PQRetain, PQRelease, NULL, PQCompare};
    CFBinaryHeapRef pq = CFBinaryHeapCreate(NULL, 0, &callBacks, NULL);

    CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:3 andName:@"Clear drains"]);
    CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:4 andName:@"Feed cat"]);
    CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:5 andName:@"Make tea"]);
    CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:1 andName:@"Solve RC tasks"]);
    CFBinaryHeapAddValue(pq, [[Task alloc] initWithPriority:2 andName:@"Tax return"]);

    while (CFBinaryHeapGetCount(pq) != 0) {
      Task *task = (id)CFBinaryHeapGetMinimum(pq);
      NSLog(@"%@", task);
      CFBinaryHeapRemoveMinimumValue(pq);
    }

    CFRelease(pq);

  }
  return 0;
}

log:

2011-08-22 07:46:19.250 Untitled[563:903] 1, Solve RC tasks
2011-08-22 07:46:19.255 Untitled[563:903] 2, Tax return
2011-08-22 07:46:19.256 Untitled[563:903] 3, Clear drains
2011-08-22 07:46:19.257 Untitled[563:903] 4, Feed cat
2011-08-22 07:46:19.258 Untitled[563:903] 5, Make tea

OCaml

Holger Arnold's [http://holgerarnold.net/software/ OCaml base library] provides a [http://holgerarnold.net/software/ocaml/doc/base/PriorityQueue.html PriorityQueue] module.

module PQ = Base.PriorityQueue

let () =
  let tasks = [
    3, "Clear drains";
    4, "Feed cat";
    5, "Make tea";
    1, "Solve RC tasks";
    2, "Tax return";
  ] in
  let pq = PQ.make (fun (prio1, _) (prio2, _) -> prio1 > prio2) in
  List.iter (PQ.add pq) tasks;
  while not (PQ.is_empty pq) do
    let _, task = PQ.first pq in
    PQ.remove_first pq;
    print_endline task
  done