(* :Title: Priority Queues *)

(* :Author: Roman E. Maeder *)

(* :Summary:
  destructive priority queues based on a heap
*)

(* :Context: PriorityQueue` *)

(* :Package Version: 1.0 *)

(* :Copyright: Copyright 1997, Roman E. Maeder.

   This package may be used for personal and instructional, noncommercial
   purposes only. Commercial licensing is available upon request.
*)

(* :History:
   Version 1.0 for the Mathematica Journal, July 1997.
*)

(* :Keywords: 
  priority queue, heap, data structures 
*)

(* :Source: 
    Maeder, Roman E. 1997. Interval Plotting and Global Optimisation.
        The Mathematica Journal, 7(2).
*)

(* :Mathematica Version:3.0 *)

BeginPackage["PriorityQueue`"]

MakeQueue::usage = "MakeQueue[pred] creates an empty priority queue with
	the given ording predicate. The default predicate is Greater."
CopyQueue::usage = "CopyQueue[q] makes a copy of the priority queue q."
DeleteQueue::usage = "DeleteQueue[q] frees the storage used for q."
EmptyQueue::usage = "EmptyQueue[q] is True if the priority queue q is empty."
EnQueue::usage = "EnQueue[a, item] inserts item into the priority queue q."
TopQueue::usage = "TopQueue[q] returns the largest item in the priority queue q."
DeQueue::usage = "DeQueue[q] removes the largest item from the priority queue q.
	It returns the item removed."
PriorityQueue::usage = "PriorityQueue[...] is the print form of priority queues."

Begin["`Private`"]

SetAttributes[queue, HoldAll]
SetAttributes[array, HoldAllComplete]

makeArray[n_] := array@@Table[Null, {n}]

MakeQueue[pred_:Greater] :=
  Module[{ar,n=0},
    ar = makeArray[2];
    queue[ar, n, pred]
  ]

CopyQueue[queue[a0_,n0_,pred_]] :=
  Module[{ar=a0,n=n0},
    queue[ar, n, pred]
  ]

EnQueue[q:queue[ar_,n_,pred_], val_] :=
  Module[{i,j},
    If[ n == Length[ar], (* extend (double size) *)
        ar = Join[ar, makeArray[Length[ar]]] ];
    n++;
    ar[[n]] = val; i = n;
    While[ True, (* restore heap *)
      j = Floor[i/2];
      If[ j < 1 || pred[ar[[j]], ar[[i]]], Break[] ];
      {ar[[i]], ar[[j]]} = {ar[[j]], ar[[i]]};
      i = j;
    ];
    q
  ]

EmptyQueue[queue[ar_,n_,pred_]] := n == 0

TopQueue[queue[ar_,n_,pred_]] := ar[[1]]

DeQueue[queue[ar_,n_,pred_]] := 
  Module[{i,j,res=ar[[1]]},
    ar[[1]] = ar[[n]]; ar[[n]] = Null; n--;
    j = 1;
    While[ j <= Floor[n/2], (* restore heap *)
      i = 2j;
      If[ i < n && pred[ar[[i+1]], ar[[i]]], i++ ];
      If[ pred[ar[[i]], ar[[j]]],
          {ar[[i]], ar[[j]]} = {ar[[j]], ar[[i]]} ];
      j = i
    ];
    res
  ]

DeleteQueue[queue[ar_,n_,pred_]] := (ClearAll[ar,n];)

queue/:Normal[q0_queue] :=
  Module[{l={}, q=CopyQueue[q0]},
    While[!EmptyQueue[q], AppendTo[l, TopQueue[q]]; DeQueue[q]];
    DeleteQueue[q];
    l
  ]

Format[q_queue/;EmptyQueue[q]] := PriorityQueue[]
Format[q_queue] := PriorityQueue[TopQueue[q], "\[TripleDot]"]

End[]

Protect[ MakeQueue, CopyQueue, DeleteQueue, EmptyQueue,
         EnQueue, TopQueue, DeQueue, PriorityQueue ]

EndPackage[]