TreeStructures 0.0.1 → 0.0.2

raw patch · 9 files changed

+400/−109 lines, 9 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Heap/Binary.hs +16/−17
• Data/Heap/Binomial.hs +22/−29
• Data/Heap/Skew.hs +20/−13
• Data/Tree/AVL.hs +163/−0
• Data/Tree/Splay.hs +99/−38
• LICENSE +26/−4
• README +4/−0
• Tests.hs +39/−0
• TreeStructures.cabal +11/−8

@@ -1,6 +1,6 @@ ----- Copyright (c) 2009 Brendan Hickey - http://bhickey.net--- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)+-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net+-- New 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.@@ -12,11 +12,11 @@  data (Ord n) => BinaryHeap n =     Leaf-  | Node n Int (BinaryHeap n) (BinaryHeap n) deriving (Eq, Ord)+  | 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) ++ ")"+  show (Node n _ h1 h2) = "Node " ++ show n ++ " (" ++ show h1 ++ " " ++ show h2 ++ ")"  rank :: (Ord n) => BinaryHeap n -> Int rank Leaf = 0@@ -34,16 +34,16 @@ 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+merge h1@(Node n1 d1 h1l h1r) h2@(Node n2 d2 _ _) = +  if  n1<n2 || (n1==n2 && d1<=d2)   then if rank h1l < rank h1r-       then (Node n1 (d1 + d2) (merge h1l h2) h1r)-       else (Node n1 (d1 + d2) h1l (merge h1r h2))+       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)+insert :: (Ord a) => a -> BinaryHeap a -> BinaryHeap a+insert a h = merge h (singleton a)  -- | /O(1)/. null :: (Ord a) => BinaryHeap a -> Bool@@ -53,17 +53,16 @@ -- | /O(n lg n)/. toList :: (Ord a) => BinaryHeap a -> [a] toList Leaf = []-toList h@(Node _ _ _ _) = (head h):(toList $ tail h)+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+fromList l = mergeList (map singleton l)+              where mergeList [a] = a+                    mergeList x = mergeList (mergePairs x)+                    mergePairs (a:b:c) = merge a b : mergePairs c+                    mergePairs x = x  -- | /O(1)/. 'head' returns the element root of the heap. head :: (Ord a) => BinaryHeap a -> a

@@ -1,6 +1,6 @@ ----- Copyright (c) 2009 Brendan Hickey - http://bhickey.net--- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)+-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net+-- New BSD License (see http://www.opensource.org/licenses/bsd-license.php) --  module Data.Heap.Binomial @@ -10,11 +10,11 @@ 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, Ord b, Eq a, Eq b) => HeapNode a b = HeapNode a {-# UNPACK #-} !Int [b]  data (Ord a, Eq a) => BinomialHeap a =      EmptyHeap-  | Heap [HeapNode a (BinomialHeap a)] deriving (Eq, Ord)+  | Heap {-# UNPACK #-} ![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@@ -44,32 +44,31 @@ singleton n = Heap [HeapNode n 1 []]  -- | /O(lg n)/-insert :: (Ord a) => BinomialHeap a -> a -> BinomialHeap a-insert h n = merge (singleton n) h+insert :: (Ord a) => a -> BinomialHeap a -> BinomialHeap a+insert a = merge (singleton a)  -- | /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)+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)+mergeNodes f@(h1 : t1) s@(h2 : t2)+    | rank h1 == rank h2 =+      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+    | rank h1 < rank h2 = h1 : mergeNodes t1 s+    | otherwise = 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 =@@ -91,16 +90,10 @@  -- | /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+fromList =  foldl merge EmptyHeap . map singleton  -- | /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)+toList h@(Heap _) = head h : (toList $ if null h then h else tail h)

@@ -1,6 +1,6 @@ ----- Copyright (c) 2009 Brendan Hickey - http://bhickey.net--- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)+-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net+-- New BSD License (see http://www.opensource.org/licenses/bsd-license.php) --  module Data.Heap.Skew @@ -24,17 +24,25 @@ 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)+insert :: (Ord a) => a -> SkewHeap a -> SkewHeap a+insert a h = 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)+merge h1 h2 = foldl1 assemble $ reverse $ listMerge head (cutRight h1) (cutRight h2) +listMerge :: (Ord b) => (a -> b) -> [a] -> [a] -> [a]+listMerge _ [] s = s+listMerge _ f [] = f+listMerge c f@(h1:t1) s@(h2:t2) =+  if c h1  <= c h2+  then h1 : listMerge c t1 s+  else h2 : listMerge c f t2+ cutRight :: (Ord a) => SkewHeap a -> [SkewHeap a] cutRight SkewLeaf = []-cutRight (SkewHeap a l r) = (SkewHeap a l SkewLeaf):(cutRight r)+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@@ -51,13 +59,12 @@  toList :: (Ord a) => SkewHeap a -> [a] toList SkewLeaf = []-toList (SkewHeap n l r) = n:(toList $ merge l r)+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+fromList l = mergeList (map singleton l)+              where mergeList [a] = a+                    mergeList x = mergeList (mergePairs x)+                    mergePairs (a:b:c) =  merge a b : mergePairs c+                    mergePairs x = x

@@ -0,0 +1,163 @@+--+-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net+-- New BSD License (see http://www.opensource.org/licenses/bsd-license.php)+--++module Data.Tree.AVL+(AVLTree, head, tail, singleton, empty, null, fromList, fromAscList, toList, toAscList, insert, delete, lookup, (!!), size) +where++import Prelude hiding (head, tail, (!!), lookup, null)+import Data.Maybe+++data AVLTree k v =+    Leaf+  | AVLTree !k !v !Int !Int !(AVLTree k v) !(AVLTree k v) deriving (Ord, Eq, Show)++-- | /O(1)/. 'singleton' constructs a singleton AVL tree+singleton :: (Ord k) => k -> v -> AVLTree k v+singleton k v = AVLTree k v 1 1 Leaf Leaf++-- | /O(1)/. 'empty' produces an empty tree+empty :: (Ord k) => AVLTree k v+empty = Leaf++-- | /O(1)/. 'null' returns True if a tree is empty, otherwise False.+null :: AVLTree k v -> Bool+null Leaf = True+null _    = False++-- | /O(1)/. 'head' returns the head of a tree.+head :: (Ord k) => AVLTree k v -> v+head Leaf = error "took the head of an empty tree"+head (AVLTree _ v _ _ _ _) = v++-- | /O(lg n)/. 'tail' discards the head of the tree and returns a tree.+tail :: (Ord k) => AVLTree k v -> AVLTree k v+tail Leaf = error "took the tail of an empty tree"+tail t@(AVLTree k _ _ _ _ _) = delete k t++-- | /O(1)/. 'size' reports the number of children in a tree+size :: AVLTree k v -> Int+size Leaf = 0+size (AVLTree _ _ s _ _ _) = s++-- | /O(1)/. 'height' reports the maximum distance to a leaf.+height :: AVLTree k v -> Int+height Leaf = 0+height (AVLTree _ _ _ h _ _) = h++findHeight :: AVLTree k v -> AVLTree k v -> Int+findHeight a b = 1 + max (height a) (height b)++findSize :: AVLTree k v -> AVLTree k v -> Int+findSize a b = 1 + size a + size b++balance :: (Ord k) => AVLTree k v -> AVLTree k v+balance Leaf = Leaf+balance t@(AVLTree k v _ _ l r)+  | abs (height l - height r) < 2 = t+  | height l < height r =+    case r of+      Leaf -> error "cannot promote a leaf" -- this should never happen+      (AVLTree k1 v1 _ _ l1 r1) -> +        let child = (AVLTree k v (findSize l l1) (findHeight l l1) l l1) in+          (AVLTree k1 v1 (findSize child r1) (findHeight child r1) child r1)  +  | otherwise = +    case l of+      Leaf -> error "cannot promote a leaf"+      (AVLTree k1 v1 _ _ l1 r1) -> +        let child = (AVLTree k v (findSize r1 r) (findHeight r1 r) r1 r) in+          (AVLTree k1 v1 (findSize l1 child) (findHeight l1 child) l1 child)++(!!) :: (Ord k) => AVLTree k v -> Int -> (k,v)+(!!) Leaf _ = error "index out of bounds"+(!!) (AVLTree k v d _ l r) n+  | n > d = error "index out of bounds"+  | otherwise = +    let l' = size l in+      if n == l'+      then (k,v)+      else if n <= l'+           then l !! n+           else r !! (n - l' - 1)++-- | /O(lg n)/.+lookup :: (Ord k) => k -> AVLTree k v -> Maybe v+lookup _ Leaf = Nothing+lookup k' (AVLTree k v _ _ l r)+  | k == k' = Just v+  | k' < k = lookup k' l+  | otherwise = lookup k' r++-- | /O(lg n)/.+insert :: (Ord k) => k -> v -> AVLTree k v -> AVLTree k v+insert k v Leaf = singleton k v+insert k v (AVLTree k1 v1 s _ l r) =+  if k <= k1+  then let l' = insert k v l in+    balance (AVLTree k1 v1 (s + 1) (findHeight l' r) l' r)+  else let r' = insert k v r in+    balance (AVLTree k1 v1 (s + 1) (findHeight l r') l r')++-- | /O(lg n)/.+delete :: (Ord k) => k -> AVLTree k v -> AVLTree k v+delete _ Leaf = Leaf+delete k t@(AVLTree k1 _ _ _ Leaf Leaf) = if k == k1 then Leaf else t+delete k t@(AVLTree k1 v1 _ _ l r)+  | k == k1 =+    case t of+      Leaf -> Leaf+      (AVLTree _ _ _ _ Leaf r1) -> +        case getLeft r1 of+          (Nothing, _) -> Leaf+          (Just (k', v'), r') -> +            balance (AVLTree k' v' (findSize Leaf r') (findHeight Leaf r') Leaf r')+      (AVLTree _ _ _ _ l1 r1) -> +        case getRight l1 of+          (Nothing, _) -> Leaf+          (Just (k', v'), l') -> +            balance (AVLTree k' v' (findSize l' r1) (findHeight l' r1) l' r1)+    | k < k1 =+      let l' = delete k l in+        balance (AVLTree k1 v1 (findSize l' r) (findHeight l' r) l' r)+    | otherwise =+      let r' = delete k r in+        balance (AVLTree k1 v1 (findSize l r') (findHeight l r') l r')++getRight :: (Ord k) => AVLTree k v -> (Maybe (k,v), AVLTree k v)+getRight Leaf = (Nothing, Leaf)+getRight (AVLTree k v _ _ Leaf Leaf) = (Just (k,v), Leaf)+getRight (AVLTree k v _ _ l Leaf) = (Just (k,v), l)+getRight (AVLTree k v _ _ l r) = +  case getRight r of+    (p, t2) -> (p, balance (AVLTree k v (findSize l t2) (findHeight l t2) l t2))++getLeft :: (Ord k) => AVLTree k v -> (Maybe (k,v), AVLTree k v)+getLeft Leaf = (Nothing, Leaf)+getLeft (AVLTree k v _ _ Leaf Leaf) = (Just (k,v), Leaf)+getLeft (AVLTree k v _ _ Leaf r) = (Just (k,v), r)+getLeft (AVLTree k v _ _ _ r) = +  case getLeft r of+    (p, t2) -> (p, AVLTree k v (findSize r t2) (findHeight r t2) t2 r)++-- | /O(n lg n)/.+fromList :: (Ord k) => [(k,v)] -> AVLTree k v+fromList [] = Leaf+fromList ((k,v):[]) = singleton k v+fromList ((k,v):tl) = insert k v (fromList tl)++-- | /O(n lg n)/.+fromAscList :: (Ord k) => [(k,v)] -> AVLTree k v+fromAscList = fromList++-- TODO implement an instance of foldable so that this can be concisely defined+-- | /O(n lg n)/.+toAscList :: (Ord k) => AVLTree k v -> [(k,v)]+toAscList Leaf = []+toAscList (AVLTree k v _ _ l r) = toAscList l ++ (k,v) : toAscList r++-- | /O(n lg n)/.+toList :: (Ord k) => AVLTree k v -> [(k,v)]+toList = toAscList

@@ -1,21 +1,21 @@ ----- Copyright (c) 2009 Brendan Hickey - http://bhickey.net--- Simplified BSD License (see http://www.opensource.org/licenses/bsd-license.php)+-- Copyright (c) 2009 - 2010 Brendan Hickey - http://bhickey.net+-- New 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) +(SplayTree, head, tail, singleton, empty, null, fromList, fromAscList, toList, toAscList, insert, lookup, (!!), splay, size, delete)  where -import Prelude hiding (head, tail, lookup, null)+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)+  | SplayTree k v Int (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+singleton (k,v) = SplayTree k v 0 Leaf Leaf  -- | /O(1)/. 'empty' constructs an empty splay tree. empty :: (Ord k) => SplayTree k v@@ -26,61 +26,122 @@ null Leaf = True null _ = False +size :: (Ord k) => SplayTree k v -> Int+size Leaf = 0+size (SplayTree _ _ d _ _) = d  -- | /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)+lookup :: (Ord k) => k -> SplayTree k v -> SplayTree k v+lookup _ Leaf = Leaf+lookup k' t@(SplayTree k _ _ l r)+  | k' == k = t+  | k > k' =+    case lookup k' l of+      Leaf -> t+      lt -> zig lt t+  | otherwise = +    case lookup k' r of+      Leaf -> t+      rt -> zag t rt --- | /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))+-- | Locates the i^{th} element in BST order without splaying it.+(!!) :: (Ord k) => SplayTree k v -> Int -> (k,v)+(!!) Leaf _ = error "index out of bounds"+(!!) (SplayTree k v d l r) n =+  if n > d+  then error "index out of bounds"+  else +    let l' = size l in+      if n == l'+      then (k,v)+      else if n <= l'+           then l !! n+           else r !! (n - l') +-- | Splays the i^{th} element in BST order+splay :: (Ord k) => SplayTree k v -> Int -> SplayTree k v+splay Leaf _ = error "index out of bounds"+splay t@(SplayTree _ _ d l r) n =+  if n > d+  then error "index out of bounds"+  else +    let l' = size l in+      if n == l'+      then t+      else if n <= l'+           then case splay l n of+                  Leaf -> error "index out of bounds"+                  lt -> zig lt t+           else case splay r (n - l') of+                  Leaf -> error "index out of bounds"+                  rt -> zag t rt +-- | /O(1)/. zig rotates its first argument up+zig :: (Ord k) => SplayTree k v -> SplayTree k v -> SplayTree k v+zig Leaf _ = error "tree corruption"+zig _ Leaf = error "tree corruption"+zig (SplayTree k1 v1 _ l1 r1) (SplayTree k v d _ r) =+  SplayTree k1 v1 d l1 (SplayTree k v (d - size l1 - 1) r1 r)++-- | /O(1)/. zig rotates its second argument up+zag :: (Ord k) => SplayTree k v -> SplayTree k v -> SplayTree k v+zag Leaf _ = error "tree corruption"+zag _ Leaf = error "tree corruption"+zag (SplayTree k v d l _) (SplayTree k1 v1 _ l1 r1) =+  SplayTree k1 v1 d (SplayTree k v (d - size r1 - 1) 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. This function is unsatisfying.+insert :: (Ord k) => k -> v -> SplayTree k v -> SplayTree k v+insert k v t =+  case lookup k t of+    Leaf -> (SplayTree k v 0 Leaf Leaf)+    (SplayTree k1 v1 d l r) ->+        if k1 < k+        then SplayTree k v (d + 1) (SplayTree k1 v1 (d - size r + 1) l Leaf) r+        else SplayTree k v (d + 1) l (SplayTree k1 v1 (d - size l + 1) 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)+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)    = +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)+    (SplayTree k v d l1 Leaf) -> (SplayTree k v (d + size r) l1 r)     _ -> error "splay tree corruption" +delete :: (Ord k) => k -> SplayTree k v -> SplayTree k v+delete _ Leaf = Leaf+delete k t = +  case lookup k t of+    t'@(SplayTree k1 _ _ _ _) -> +      if k == k1+      then tail t'+      else t'+    Leaf -> 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)+splayRight h@(SplayTree _ _ _ _ Leaf) = h+splayRight (SplayTree k1 v1 d1 l1 (SplayTree k2 v2 _ l2 r2)) = +  splayRight (SplayTree k2 v2 d1 (SplayTree k1 v1 (d1 - size r2) 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))+splayLeft h@(SplayTree _ _ _ Leaf _) = h+splayLeft (SplayTree k1 v1 d1 (SplayTree k2 v2 _ l2 r2) r1) = +  splayLeft (SplayTree k2 v2 d1 l2 (SplayTree k1 v1 (d1 - size l2) 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+fromList l = foldl (\ acc (k,v) -> insert k v acc) 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@@ -92,6 +153,6 @@  -- | /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 h@(SplayTree _ _ _ Leaf _) = head h : toAscList (tail h) toAscList Leaf = [] toAscList h = toAscList $ splayLeft h

@@ -1,9 +1,31 @@ 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:+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.+Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer. -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.+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.++Neither the name of the author, nor the names of its contributors+may be used to endorse or promote products derived from this software+without specific prior written permission.++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.++

@@ -0,0 +1,4 @@+TreeStructures 0.0.2+Author: Brendan Hickey++Tree and heap data structures for Haskell.

@@ -0,0 +1,39 @@+import Char+import List +import Test.QuickCheck+import Text.Printf+import qualified Data.Heap.Binary as B+import qualified Data.Heap.Binomial as N+import qualified Data.Heap.Skew as S+import qualified Data.Tree.AVL as A+import qualified Data.Tree.Splay as P++binary_fromListToList s = (B.toList . B.fromList) s == sort s+  where _ = s :: [Int]++binomial_fromListToList s = (N.toList . N.fromList) s == sort s+  where _ = s :: [Int]++skew_fromListToList s = (S.toList . S.fromList) s == sort s+  where _ = s :: [Int]++avl_fromListToList s = (map fst . A.toList . A.fromList) s == (map fst . sort) s+  where _ = s :: [(Int,Int)]++splay_fromListToList s = (map fst . P.toList . P.fromList) s == (map fst . sort) s+  where _ = s :: [(Int,Int)]++++tests = [+    ("Heap.Binary:   toList.fromList/sort", test binary_fromListToList),+    ("Heap.Binomial: toList.fromList/sort", test binomial_fromListToList),+    ("Heap.Skew:     toList.fromList/sort", test skew_fromListToList),+    ("Tree.AVL:      toList.fromList/sort", test avl_fromListToList),+    ("Tree.Splay:    toList.fromList/sort", test splay_fromListToList)]++main  = mapM_ (\(s,a) -> printf "%-25s: " s >> a) tests+ +instance Arbitrary Char where+    arbitrary     = choose ('\0', '\128')+    coarbitrary c = variant (ord c `rem` 4)

@@ -1,21 +1,24 @@ Name:               TreeStructures-Version:            0.0.1-Synopsis:           Tree structures-Description:        A collection of heaps and search trees+Version:            0.0.2+Synopsis:           A collection of heaps and search trees+Description:        This package presently includes binary heaps, binomial heaps, skew heaps, splay trees, and AVL trees. License:            BSD3 License-file:       LICENSE Author:             Brendan Hickey-Maintainer:         brendan@bhickey.net-Homepage:           http://hg.bhickey.net-Stability:          experimental-Category:           DataStructures+Maintainer:         Brendan Hickey+Homepage:           http://www.github.com/bhickey/TreeStructures+Stability:          Experimental+Category:           Data Structures Build-Type:         Simple Cabal-Version:      >=1.2 +extra-source-files: Tests.hs README+ Library-  Build-Depends:    base+  Build-Depends:    base >= 2 && < 4   Exposed-modules:  Data.Heap.Binary                      Data.Heap.Binomial                      Data.Heap.Skew                     Data.Tree.Splay+                    Data.Tree.AVL   ghc-options:      -Wall