summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBrendanHickey <>2009-03-17 05:41:56 (GMT)
committerLuite Stegeman <luite@luite.com>2009-03-17 05:41:56 (GMT)
commit3655c8ac993eb1163f70cfd1dd02e4e719d7e62d (patch)
tree4961b10c893e94a8aefb5076ede7c279101b6802
version 0.0.10.0.1
-rw-r--r--Data/Heap/Binary.hs76
-rw-r--r--Data/Heap/Binomial.hs106
-rw-r--r--Data/Heap/Skew.hs63
-rw-r--r--Data/Tree/Splay.hs97
-rw-r--r--LICENSE9
-rw-r--r--Setup.hs2
-rw-r--r--TreeStructures.cabal21
7 files changed, 374 insertions, 0 deletions
diff --git a/Data/Heap/Binary.hs b/Data/Heap/Binary.hs
new file mode 100644
index 0000000..c9bd084
--- /dev/null
+++ b/Data/Heap/Binary.hs
@@ -0,0 +1,76 @@
+--
+-- Copyright (c) 2009 Brendan Hickey - http://bhickey.net
+-- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)
+--
+
+-- | 'Data.Heap.Binary' provides a binary min-heap. Balance is maintained through descendant counting.
+module Data.Heap.Binary
+(BinaryHeap, head, tail, merge, singleton, empty, null, fromList, toList, insert)
+where
+
+import Prelude hiding (head, tail, null)
+
+data (Ord n) => BinaryHeap n =
+ Leaf
+ | Node n Int (BinaryHeap n) (BinaryHeap n) deriving (Eq, Ord)
+
+instance (Ord n, Show n) => Show (BinaryHeap n) where
+ show Leaf = "Leaf"
+ show (Node n _ h1 h2) = "Node " ++ (show n) ++ " (" ++ (show h1) ++ " " ++ (show h2) ++ ")"
+
+rank :: (Ord n) => BinaryHeap n -> Int
+rank Leaf = 0
+rank (Node _ d _ _) = d
+
+-- | /O(1)/. 'empty' produces an empty heap.
+empty :: (Ord a) => BinaryHeap a
+empty = Leaf
+
+-- | /O(1)/. 'singleton' consumes an element and constructs a singleton heap.
+singleton :: (Ord a) => a -> BinaryHeap a
+singleton a = Node a 1 Leaf Leaf
+
+-- | 'merge' consumes two binary heaps and merges them.
+merge :: (Ord a) => BinaryHeap a -> BinaryHeap a -> BinaryHeap a
+merge Leaf n = n
+merge n Leaf = n
+merge h1@(Node n1 d1 h1l h1r) h2@(Node _ d2 _ _) =
+ if head h1 == head h2 || h1 <= h2
+ then if rank h1l < rank h1r
+ then (Node n1 (d1 + d2) (merge h1l h2) h1r)
+ else (Node n1 (d1 + d2) h1l (merge h1r h2))
+ else merge h2 h1
+
+-- | /O(lg n)/.
+insert :: (Ord a) => BinaryHeap a -> a -> BinaryHeap a
+insert h a = merge h (singleton a)
+
+-- | /O(1)/.
+null :: (Ord a) => BinaryHeap a -> Bool
+null Leaf = True
+null _ = False
+
+-- | /O(n lg n)/.
+toList :: (Ord a) => BinaryHeap a -> [a]
+toList Leaf = []
+toList h@(Node _ _ _ _) = (head h):(toList $ tail h)
+
+-- | /O(n)/. 'fromList' constructs a binary heap from an unsorted list.
+fromList :: (Ord a) => [a] -> BinaryHeap a
+fromList [] = Leaf
+fromList l = (\ ((hd:_):_) -> hd) $! dropWhile (\ x -> length x > 1) $ iterate (pairWise merge) $ map singleton l
+
+pairWise :: (a -> a -> a) -> [a] -> [a]
+pairWise _ [] = []
+pairWise f (a:b:tl) = (f a b):(pairWise f tl)
+pairWise _ a = a
+
+-- | /O(1)/. 'head' returns the element root of the heap.
+head :: (Ord a) => BinaryHeap a -> a
+head Leaf = error "Data.Tree.Heap: empty list"
+head (Node n _ _ _) = n
+
+-- | /O(lg n)/. 'tail' discards the root of the heap and merges the subtrees.
+tail :: (Ord a) => BinaryHeap a -> BinaryHeap a
+tail Leaf = error "Data.Heap empty list"
+tail (Node _ _ h1 h2) = merge h1 h2
diff --git a/Data/Heap/Binomial.hs b/Data/Heap/Binomial.hs
new file mode 100644
index 0000000..f705789
--- /dev/null
+++ b/Data/Heap/Binomial.hs
@@ -0,0 +1,106 @@
+--
+-- Copyright (c) 2009 Brendan Hickey - http://bhickey.net
+-- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)
+--
+
+module Data.Heap.Binomial
+(BinomialHeap, head, tail, merge, singleton, empty, null, fromList, toList, insert)
+where
+
+import Prelude hiding (head, tail, null)
+import Data.List (delete)
+
+data (Ord a, Ord b, Eq a, Eq b) => HeapNode a b = HeapNode a Int [b]
+
+data (Ord a, Eq a) => BinomialHeap a =
+ EmptyHeap
+ | Heap [HeapNode a (BinomialHeap a)] deriving (Eq, Ord)
+
+instance (Ord a, Ord b, Eq a, Eq b) => Ord (HeapNode a b) where
+ compare (HeapNode e1 _ _) (HeapNode e2 _ _) = compare e1 e2
+
+instance (Ord a, Ord b, Eq a, Eq b) => Eq (HeapNode a b) where
+ (HeapNode e1 _ _) == (HeapNode e2 _ _) = e1 == e2
+
+rank :: (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> Int
+rank (HeapNode _ n _) = n
+
+hRank :: (Ord a, Ord b, Eq a, Eq b) => [HeapNode a b] -> Int
+hRank [] = 0
+hRank (hd:_) = rank hd
+
+extract :: (Ord a, Ord b, Eq a, Eq b) => HeapNode a b -> a
+extract (HeapNode n _ _) = n
+
+empty :: (Ord a) => BinomialHeap a
+empty = EmptyHeap
+
+null :: (Ord a) => BinomialHeap a -> Bool
+null EmptyHeap = True
+null _ = False
+
+-- | /O(1)/.
+singleton :: (Ord a) => a -> BinomialHeap a
+singleton n = Heap [HeapNode n 1 []]
+
+-- | /O(lg n)/
+insert :: (Ord a) => BinomialHeap a -> a -> BinomialHeap a
+insert h n = merge (singleton n) h
+
+-- | /O(lg n)/.
+merge :: (Ord a) => BinomialHeap a -> BinomialHeap a -> BinomialHeap a
+merge EmptyHeap n = n
+merge n EmptyHeap = n
+merge (Heap h1) (Heap h2) = Heap $! (mergeNodes h1 h2)
+
+mergeNodes :: (Ord a, Eq a) => [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)] -> [HeapNode a (BinomialHeap a)]
+mergeNodes [] h = h
+mergeNodes h [] = h
+mergeNodes f@(h1:t1) s@(h2:t2) =
+ if rank h1 == rank h2
+ then let merged = (combine h1 h2)
+ r = rank merged in
+ if r /= hRank t1
+ then if r /= hRank t2
+ then merged:(mergeNodes t1 t2)
+ else mergeNodes (merged:t1) t2
+ else if r /= hRank t2
+ then mergeNodes t1 (merged:t2)
+ else merged:(mergeNodes t1 t2)
+ else if rank h1 < rank h2
+ then h1:(mergeNodes t1 s)
+ else h2:(mergeNodes t2 f)
+
+combine :: (Ord a, Eq a) => HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a) -> HeapNode a (BinomialHeap a)
+combine h1@(HeapNode e1 n1 l1) h2 =
+ if h1 <= h2
+ then HeapNode e1 (n1 + 1) (l1 ++ [Heap [h2]])
+ else combine h2 h1
+
+-- | /O(lg n)/
+head :: (Ord a) => BinomialHeap a -> a
+head EmptyHeap = error "Data.Heap: empty list"
+head (Heap hn) = extract $! minimum hn
+
+-- | /O(lg n)/
+tail :: (Ord a) => BinomialHeap a -> BinomialHeap a
+tail EmptyHeap = error "Data.Heap: empty list"
+tail (Heap hn) =
+ let n@(HeapNode _ _ hd) = (minimum hn) in
+ foldl merge (Heap (delete n hn)) hd
+
+-- | /O(n)/
+fromList :: (Ord a, Eq a) => [a] -> BinomialHeap a
+fromList [] = EmptyHeap
+fromList l = (\ ((hd:_):_) -> hd) $ dropWhile (\ x -> length x > 1) $ iterate (pairWise merge) $! map singleton l
+
+pairWise :: (a -> a -> a) -> [a] -> [a]
+pairWise _ [] = []
+pairWise f (a:b:tl) = (f a b):(pairWise f tl)
+pairWise _ a = a
+
+-- | /O(n lg n)/
+toList :: (Ord a) => BinomialHeap a -> [a]
+toList EmptyHeap = []
+toList (Heap []) = []
+toList h@(Heap _) = (head h):(toList $ if null h then h else tail h)
diff --git a/Data/Heap/Skew.hs b/Data/Heap/Skew.hs
new file mode 100644
index 0000000..b97f55f
--- /dev/null
+++ b/Data/Heap/Skew.hs
@@ -0,0 +1,63 @@
+--
+-- Copyright (c) 2009 Brendan Hickey - http://bhickey.net
+-- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)
+--
+
+module Data.Heap.Skew
+(SkewHeap, head, tail, merge, singleton, empty, null, fromList, toList, insert)
+where
+
+import Prelude hiding (head, tail, null)
+import qualified Data.List as L
+
+data (Ord a) => SkewHeap a =
+ SkewLeaf
+ | SkewHeap a (SkewHeap a) (SkewHeap a) deriving (Eq, Ord)
+
+empty :: (Ord a) => SkewHeap a
+empty = SkewLeaf
+
+null :: (Ord a) => SkewHeap a -> Bool
+null SkewLeaf = True
+null _ = False
+
+singleton :: (Ord a) => a -> SkewHeap a
+singleton n = SkewHeap n SkewLeaf SkewLeaf
+
+insert :: (Ord a) => SkewHeap a -> a -> SkewHeap a
+insert h a = merge h (singleton a)
+
+merge :: (Ord a) => SkewHeap a -> SkewHeap a -> SkewHeap a
+merge SkewLeaf n = n
+merge n SkewLeaf = n
+merge h1 h2 = foldl1 assemble $ L.sortBy (\ x y -> compare y x) $ (cutRight h1) ++ (cutRight h2)
+
+cutRight :: (Ord a) => SkewHeap a -> [SkewHeap a]
+cutRight SkewLeaf = []
+cutRight (SkewHeap a l r) = (SkewHeap a l SkewLeaf):(cutRight r)
+
+-- assumes h1 >= h2, merge relies on this
+assemble :: (Ord a) => SkewHeap a -> SkewHeap a -> SkewHeap a
+assemble h1 (SkewHeap a l SkewLeaf) = SkewHeap a h1 l
+assemble _ _ = error "invalid heap assembly"
+
+head :: (Ord a) => SkewHeap a -> a
+head SkewLeaf = error "head of empty heap"
+head (SkewHeap a _ _) = a
+
+tail :: (Ord a) => SkewHeap a -> SkewHeap a
+tail SkewLeaf = error "tail of empty heap"
+tail (SkewHeap _ l r) = merge l r
+
+toList :: (Ord a) => SkewHeap a -> [a]
+toList SkewLeaf = []
+toList (SkewHeap n l r) = n:(toList $ merge l r)
+
+fromList :: (Ord a) => [a] -> SkewHeap a
+fromList [] = SkewLeaf
+fromList l = (\ ((hd:_):_) -> hd) $! dropWhile (\ x -> length x > 1) $ iterate (pairWise merge) $ map singleton l
+
+pairWise :: (a -> a -> a) -> [a] -> [a]
+pairWise _ [] = []
+pairWise f (a:b:tl) = (f a b):(pairWise f tl)
+pairWise _ a = a
diff --git a/Data/Tree/Splay.hs b/Data/Tree/Splay.hs
new file mode 100644
index 0000000..496ffac
--- /dev/null
+++ b/Data/Tree/Splay.hs
@@ -0,0 +1,97 @@
+--
+-- Copyright (c) 2009 Brendan Hickey - http://bhickey.net
+-- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)
+--
+
+module Data.Tree.Splay
+(SplayTree, head, tail, singleton, empty, null, fromList, fromAscList, toList, toAscList, insert, lookup)
+where
+
+import Prelude hiding (head, tail, lookup, null)
+
+data (Ord k) => SplayTree k v =
+ Leaf
+ | SplayTree k v (SplayTree k v) (SplayTree k v) deriving (Ord, Eq)
+
+-- | /O(1)/. 'singleton' constructs a splay tree containing one element.
+singleton :: (Ord k) => (k,v) -> SplayTree k v
+singleton (k,v) = SplayTree k v Leaf Leaf
+
+-- | /O(1)/. 'empty' constructs an empty splay tree.
+empty :: (Ord k) => SplayTree k v
+empty = Leaf
+
+-- | /O(1)/. 'null' returns true if a splay tree is empty.
+null :: (Ord k) => SplayTree k v -> Bool
+null Leaf = True
+null _ = False
+
+
+-- | /Amortized O(lg n)/. Given a splay tree and a key, 'lookup' attempts to find a node with the specified key and splays this node to the root. If the key is not found, the nearest node is brought to the root of the tree.
+lookup :: (Ord k) => SplayTree k v -> k -> SplayTree k v
+lookup Leaf _ = Leaf
+lookup n@(SplayTree k v l r) sk =
+ if sk == k
+ then n
+ else if k > sk
+ then case lookup l sk of
+ Leaf -> n
+ (SplayTree k1 v1 l1 r1) -> (SplayTree k1 v1 l1 (SplayTree k v r1 r))
+ else case lookup r sk of
+ Leaf -> n
+ (SplayTree k1 v1 l1 r1) -> (SplayTree k1 v1 (SplayTree k v l l1) r1)
+
+-- | /Amortized O(lg n)/. Given a splay tree and a key-value pair, 'insert' places the the pair into the tree in BST order.
+insert :: (Ord k) => SplayTree k v -> (k,v) -> SplayTree k v
+insert t (k,v) =
+ case lookup t k of
+ Leaf -> (SplayTree k v Leaf Leaf)
+ (SplayTree k1 v1 l r) ->
+ if k1 < k
+ then (SplayTree k v (SplayTree k1 v1 l Leaf) r)
+ else (SplayTree k v l (SplayTree k1 v1 Leaf r))
+
+
+-- | /O(1)/. 'head' returns the key-value pair of the root.
+head :: (Ord k) => SplayTree k v -> (k,v)
+head Leaf = error "head of empty tree"
+head (SplayTree k v _ _) = (k,v)
+
+-- | /Amortized O(lg n)/. 'tail' removes the root of the tree and merges its subtrees
+tail :: (Ord k) => SplayTree k v -> SplayTree k v
+tail Leaf = error "tail of empty tree"
+tail (SplayTree _ _ Leaf r) = r
+tail (SplayTree _ _ l Leaf) = l
+tail (SplayTree _ _ l r) =
+ case splayRight l of
+ (SplayTree k v l1 Leaf) -> (SplayTree k v l1 r)
+ _ -> error "splay tree corruption"
+
+splayRight :: (Ord k) => SplayTree k v -> SplayTree k v
+splayRight Leaf = Leaf
+splayRight h@(SplayTree _ _ _ Leaf) = h
+splayRight (SplayTree k1 v1 l1 (SplayTree k2 v2 l2 r2)) = splayRight $ (SplayTree k2 v2 (SplayTree k1 v1 l1 l2) r2)
+
+splayLeft :: (Ord k) => SplayTree k v -> SplayTree k v
+splayLeft Leaf = Leaf
+splayLeft h@(SplayTree _ _ Leaf _) = h
+splayLeft (SplayTree k1 v1 (SplayTree k2 v2 l2 r2) r1) = splayLeft $ (SplayTree k2 v2 l2 (SplayTree k1 v1 r2 r1))
+
+-- | /O(n lg n)/. Constructs a splay tree from an unsorted list of key-value pairs.
+fromList :: (Ord k) => [(k,v)] -> SplayTree k v
+fromList [] = Leaf
+fromList l = foldl (\ acc x -> insert acc x) Leaf l
+
+-- | /O(n lg n)/. Constructs a splay tree from a list of key-value pairs sorted in ascending order.
+fromAscList :: (Ord k) => [(k,v)] -> SplayTree k v
+fromAscList = fromList
+
+-- | /O(n lg n)/. Converts a splay tree into a list of key-value pairs with no constraint on ordering.
+toList :: (Ord k) => SplayTree k v -> [(k,v)]
+toList = toAscList
+
+-- | /O(n lg n)/. 'toAscList' converts a splay tree to a list of key-value pairs sorted in ascending order.
+toAscList :: (Ord k) => SplayTree k v -> [(k,v)]
+toAscList h@(SplayTree _ _ Leaf _) = (head h):(toAscList $ tail h)
+toAscList Leaf = []
+toAscList h = toAscList $ splayLeft h
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..31a2830
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,9 @@
+Copyright (c) 2009, Brendan Hickey <brendan@bhickey.net>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/TreeStructures.cabal b/TreeStructures.cabal
new file mode 100644
index 0000000..67ccc72
--- /dev/null
+++ b/TreeStructures.cabal
@@ -0,0 +1,21 @@
+Name: TreeStructures
+Version: 0.0.1
+Synopsis: Tree structures
+Description: A collection of heaps and search trees
+License: BSD3
+License-file: LICENSE
+Author: Brendan Hickey
+Maintainer: brendan@bhickey.net
+Homepage: http://hg.bhickey.net
+Stability: experimental
+Category: DataStructures
+Build-Type: Simple
+Cabal-Version: >=1.2
+
+Library
+ Build-Depends: base
+ Exposed-modules: Data.Heap.Binary
+ Data.Heap.Binomial
+ Data.Heap.Skew
+ Data.Tree.Splay
+ ghc-options: -Wall