/* Pure's priority queue data structure implemented as binary trees */

/* Copyright (c) 2008-2012 by Albert Graef <Dr.Graef@t-online.de>.

   This file is part of the Pure standard library.

   The Pure standard library is free software: you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public License as
   published by the Free Software Foundation, either version 3 of the License,
   or (at your option) any later version.

   Pure is distributed in the hope that it will be useful, but WITHOUT ANY
   WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public License for
   more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <http://www.gnu.org/licenses/>. */


/* .. module:: heap

   Heaps
   -----

   Heaps are a kind of priority queue data structure which allows quick
   (constant time) access to the smallest member, and to remove the smallest
   member and insert new elements in logarithmic time. Our implementation does
   not allow quick update of arbitrary heap members; if such functionality is
   required, bags can be used instead (see `Sets and Bags`_).

   Heap members *must* be ordered by the :func:`<=` predicate. Multiple
   instances of the same element may be stored in a heap; however, the order
   in which equal elements are retrieved is not specified.

   .. type:: heap /type

      The heap data type.

   Imports
   ~~~~~~~

   To use the operations of this module, add the following import declaration
   to your program::

     using heap;

   Operations
   ~~~~~~~~~~

   .. function:: emptyheap

      return the empty heap

   .. function:: heap xs

      create a heap from a list ``xs``

   .. function:: heapp x

      check whether ``x`` is a heap

   .. function:: prefix # /heap h

      size of a heap

   .. function:: null /heap h

      test whether ``h`` is the empty heap

   .. function:: members /heap h
      		 list /heap h

      list the members of ``h`` in ascending order

   .. function:: first /heap h

      the first (i.e., smallest) member of ``h``

   .. function:: rmfirst /heap h

      remove the first (i.e., smallest) member from ``h``

   .. function:: insert /heap h x

      insert ``x`` into ``h``

   Examples
   ~~~~~~~~

   ::

     > let h::heap = heap [5,1,3,11,3];
     > members h;
     [1,3,3,5,11]
     > first h;
     1
     > members $ rmfirst h;
     [3,3,5,11]

*/

// This should be considered private.
public Heap;

type heap (Heap _);

/* Note that these are declared in the global namespace. The 'heap' namespace
   is only used for the heap constructors and our private functions, see
   below. */

public heapp emptyheap heap null members list first rmfirst insert;

namespace heap;

/* Tree constructors. */
private nonfix nil;
private bin;

// create an empty heap
::emptyheap			= Heap nil;

// create a heap from a list
::heap xs::rlist		= foldl insert emptyheap xs;

// check whether h is a heap
::heapp x			= typep heap x;

// get size of a heap
::#(Heap h)			= #h
with
  #nil				= 0;
  #bin 0 _ h1 _			= #h1 * 2 + 1;
  #bin 1 _ h1 _			= #h1 * 2
end;

// test for an empty heap
::null (Heap nil)		= 1;
::null (Heap _)			= 0 otherwise;

// get members of a heap as an ordered list
::members h@(Heap _)		= [] if null h;
				= accum [first h] (rmfirst h)
with
  accum ys h			= reverse ys if null h;
				= accum ((first h):ys) (rmfirst h)
end;

::list h@(Heap _)		= members h;

// get the first (smallest) member of a heap
::first (Heap (bin _ x _ _))	= x;

// remove the first (smallest) member of a heap
::rmfirst (Heap h)		= Heap (rmfirst h)
with
  rmfirst (bin 0 _ nil nil)	= nil;
  rmfirst (bin 0 _ h1  h2 )	= update (bin 1 (last h2) h1 (rmlast h2));
  rmfirst (bin 1 _ h1  h2 )	= update (bin 0 (last h1) (rmlast h1) h2);

  last (bin 0 x::int    nil nil) |
  last (bin 0 x::string nil nil) |
  last (bin 0 x         nil nil)
				= x;
  last (bin 0 _ _ h2)		= last h2;
  last (bin 1 _ h1 _)		= last h1;

  update (bin 0 x::int    nil nil) |
  update (bin 0 x::string nil nil) |
  update (bin 0 x         nil nil)
				= bin 0 x nil nil;
  update (bin 1 x::int    (bin b1::int x1::int    h1 h2) nil) |
  update (bin 1 x::string (bin b1::int x1::string h1 h2) nil) |
  update (bin 1 x         (bin b1::int x1         h1 h2) nil)
				= bin 1 x (bin b1 x1 h1 h2) nil
				      if x <= x1;
				= bin 1 x1 (update (bin b1 x h1 h2))
				  nil otherwise;
  update (bin b::int x::int    (bin b1::int x1::int    h1 h2)
					(bin b2::int x2::int    h3 h4)) |
  update (bin b::int x::string (bin b1::int x1::string h1 h2)
					(bin b2::int x2::string h3 h4)) |
  update (bin b::int x         (bin b1::int x1         h1 h2)
					(bin b2::int x2         h3 h4))
				= bin b x (bin b1 x1 h1 h2) (bin b2 x2 h3 h4)
				      if (x <= x1) && (x <= x2);
				= bin b x1 (update (bin b1 x h1 h2))
				  (bin b2 x2 h3 h4)
				      if x1 <= x2;
				= bin b x2 (bin b1 x1 h1 h2)
				  (update (bin b2 x h3 h4))
				      otherwise;

  rmlast (bin 0 _ nil nil)	= nil;
  rmlast (bin 0 x h1  h2 )	= bin 1 x h1 (rmlast h2);
  rmlast (bin 1 x h1  h2 )	= bin 0 x (rmlast h1) h2;
end;

// insert a new member into a heap
::insert (Heap h) y::int    |
::insert (Heap h) y::string |
::insert (Heap h) y		= Heap (insert h y)
with
  insert nil y::int    |
  insert nil y::string |
  insert nil y			= bin 0 y nil nil;

  insert (bin 0 x::int    h1 h2) y::int    |
  insert (bin 0 x::string h1 h2) y::string |
  insert (bin 0 x         h1 h2) y
				= bin 1 x (insert h1 y) h2 if x <= y;
				= bin 1 y (insert h1 x) h2 otherwise;
  insert (bin 1 x::int    h1 h2) y::int    |
  insert (bin 1 x::string h1 h2) y::string |
  insert (bin 1 x         h1 h2) y
				= bin 0 x h1 (insert h2 y) if x <= y;
				= bin 0 y h1 (insert h2 x) otherwise
end;

// equality test
(Heap h1) ::== (Heap h2)	=  eq h1 h2
with
  eq nil nil			= 1;
  eq nil (bin _ _ _ _)		= 0;
  eq (bin _ _ _ _) nil		= 0;
  eq (bin b1::int x1::int    h1 h2) (bin b2::int x2::int    h3 h4) |
  eq (bin b1::int x1::string h1 h2) (bin b2::int x2::string h3 h4) |
  eq (bin b1::int x1         h1 h2) (bin b2::int x2         h3 h4)
				= if (b1 == b2)
				  then if (x1 == x2)
				       then if eq h1 h3
					    then eq h2 h4
					    else 0
				       else 0
				  else 0
end;;

// inequality test
(Heap h1) ::~= (Heap h2)	= neq h1 h2
with
  neq nil nil			= 0;
  neq nil (bin _ _ _ _)		= 1;
  neq (bin _ _ _ _) nil		= 1;
  neq (bin b1::int x1::int    h1 h2) (bin b2::int x2::int    h3 h4) |
  neq (bin b1::int x1::string h1 h2) (bin b2::int x2::string h3 h4) |
  neq (bin b1::int x1         h1 h2) (bin b2::int x2         h3 h4)
				= if (b1 ~= b2)
				  then 1
				  else if (x1 ~= x2)
				       then 1
				       else if neq h1 h3
					    then 1
					    else neq h2 h4
end;
