[pure-lang-svn] SF.net SVN: pure-lang: [383] pure/trunk/examples/heap.pure
Status: Beta
Brought to you by:
agraef
Menu
▾
▴
[pure-lang-svn] SF.net SVN: pure-lang: [383] pure/trunk/examples/heap.pure
|
From: <js...@us...> - 2008-07-04 19:54:44
|
Revision: 383
http://pure-lang.svn.sourceforge.net/pure-lang/?rev=383&view=rev
Author: jspitz
Date: 2008-07-04 12:54:52 -0700 (Fri, 04 Jul 2008)
Log Message:
-----------
Add heap data container to examples.
Added Paths:
-----------
pure/trunk/examples/heap.pure
Added: pure/trunk/examples/heap.pure
===================================================================
--- pure/trunk/examples/heap.pure (rev 0)
+++ pure/trunk/examples/heap.pure 2008-07-04 19:54:52 UTC (rev 383)
@@ -0,0 +1,154 @@
+/* Pure's priority queue data structure implemented as binary trees */
+
+/* Copyright (c) 2008 by Albert Graef <Dr....@t-...>.
+
+ This file is part of the Pure programming language and system.
+
+ Pure is free software: you can redistribute it and/or modify it under the
+ terms of the GNU 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 General Public License for more
+ details.
+
+ You should have received a copy of the GNU General Public License along
+ with this program. If not, see <http://www.gnu.org/licenses/>. */
+
+
+/* Heaps allow quick (constant time) access to the smallest member, and to
+ remove the smallest nember and insert new elements in logarithmic time.
+ This implementation does not allow quick update of heap members; if
+ such functionality is required, bags should be used instead
+ (see bag in set.pure).
+
+ Heap members must be ordered by the <= 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. */
+
+/* Public operations: ******************************************************
+
+// #h // size of a heap
+
+// null h // tests whether h is the empty heap
+// list h, members h // lists members of h in ascending order
+
+// first h // first (i.e. smallest) member of h
+// rmfirst h // remove smallest member from h
+// insert h x // insert h into x
+
+ *************************************************************************/
+
+/* Empty tree constant, consider this private. */
+nullary nil;
+
+// create an empty heap
+emptyheap = Heap nil;
+
+// create a heap from a list
+heap xs = foldl insert emptyheap xs if listp xs;
+
+// check whether h is a heap
+heapp (Heap _) = 1;
+heapp _ = 0 otherwise;
+
+// 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 nil nil) = x;
+ last (bin 0 _ _ h2) = last h2;
+ last (bin 1 _ h1 _) = last h1;
+
+ update (bin 0 x nil nil) = bin 0 x nil nil;
+ update (bin 1 x (bin b1 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 x (bin b1 x1 h1 h2) (bin b2 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 = Heap (insert h y)
+with
+ insert nil y = bin 0 y nil nil;
+ 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 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 x1 h1 h2) (bin b2 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;;
+
+// inequaliy test
+(Heap h1) != (Heap h2) = neq h1 h2
+with
+ neq nil nil = 0;
+ neq nil (bin _ _ _ _) = 1;
+ neq (bin _ _ _ _) nil = 1;
+ neq (bin b1 x1 h1 h2) (bin b2 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;
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
