heaps 0.1 → 0.2

raw patch · 2 files changed

+81/−25 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Heap.hs +80/−24
• heaps.cabal +1/−1

@@ -1,5 +1,4 @@ {-# LANGUAGE DeriveDataTypeable #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Data.Heap@@ -42,7 +41,7 @@     , insert            -- O(1) :: Ord a => a -> Heap a -> Heap a     , minimum           -- O(1) (/partial/) :: Ord a => Heap a -> a     , deleteMin         -- O(log n) :: Heap a -> Heap a-    , meld              -- O(1) :: Heap a -> Heap a -> Heap a+    , union             -- O(1) :: Heap a -> Heap a -> Heap a     , uncons, viewMin   -- O(1)\/O(log n) :: Heap a -> Maybe (a, Heap a)     -- * Transformations     , mapMonotonic      -- O(n) :: Ord b => (a -> b) -> Heap a -> Heap b @@ -50,6 +49,7 @@     -- * To/From Lists     , toUnsortedList    -- O(n) :: Heap a -> [a]     , fromList          -- O(n) :: Ord a => [a] -> Heap a +    , sort              -- O(n log n) :: Ord a => [a] -> [a]     , traverse          -- O(n log n) :: (Applicative t, Ord b) => (a -> t b) -> Heap a -> t (Heap b)     , mapM              -- O(n log n) :: (Monad m, Ord b) => (a -> m b) -> Heap a -> m (Heap b)     , concatMap         -- O(n) :: Ord b => Heap a -> (a -> Heap b) -> Heap b@@ -123,6 +123,7 @@        1 -> k (z fromList)        _ -> error "gunfold" + heapDataType :: DataType heapDataType = mkDataType "Data.Heap.Heap" [fromListConstr] @@ -154,6 +155,7 @@             go f [] []    = EQ             go f [] (_:_) = LT             go f (_:_) [] = GT+      -- | /O(1)/. Is the heap empty? --@@ -206,12 +208,12 @@  -- | /O(1)/. Meld the values from two heaps into one heap. ----- > meld (fromList [1,3,5]) (fromList [6,4,2]) = fromList [1..6]--- > meld (fromList [1,1,1]) (fromList [1,2,1]) = fromList [1,1,1,1,1,2]-meld :: Heap a -> Heap a -> Heap a -meld Empty q = q-meld q Empty = q-meld (Heap s1 leq t1@(Node _ x1 f1)) (Heap s2 _ t2@(Node _ x2 f2))+-- > union (fromList [1,3,5]) (fromList [6,4,2]) = fromList [1..6]+-- > union (fromList [1,1,1]) (fromList [1,2,1]) = fromList [1,1,1,1,1,2]+union :: Heap a -> Heap a -> Heap a +union Empty q = q+union q Empty = q+union (Heap s1 leq t1@(Node _ x1 f1)) (Heap s2 _ t2@(Node _ x2 f2))     | leq x1 x2 = Heap (s1 + s2) leq (Node 0 x1 (skewInsert leq t2 f1))     | otherwise = Heap (s1 + s2) leq (Node 0 x2 (skewInsert leq t1 f2)) @@ -225,13 +227,13 @@     | otherwise = f (singleton x0) y0     where         f x y -            | even y = f (meld x x) (quot y 2)+            | even y = f (union x x) (quot y 2)             | y == 1 = x-            | otherwise = g (meld x x) (quot (y - 1) 2) x+            | otherwise = g (union x x) (quot (y - 1) 2) x         g x y z -            | even y = g (meld x x) (quot y 2) z-            | y == 1 = meld x z-            | otherwise = g (meld x x) (quot (y - 1) 2) (meld x z)+            | even y = g (union x x) (quot y 2) z+            | y == 1 = union x z+            | otherwise = g (union x x) (quot (y - 1) 2) (union x z)  -- | /O(1)/ access to the minimum element.  --   /O(log n)/ access to the remainder of the heap @@ -270,6 +272,56 @@         f2 = skewMeld leq (skewMeld leq ts1 ts2) f1         f3 = foldr (skewInsert leq) f2 (trees zs) +-- | /O(log n)/. Adjust the minimum key in the heap and return the resulting heap.+adjustMin :: (a -> a) -> Heap a -> Heap a+adjustMin _ Empty = Empty+adjustMin f (Heap s leq (Node r x xs)) = Heap s leq (heapify leq (Node r (f x) xs))++type ForestZipper a = (Forest a, Forest a)++zipper :: Forest a -> ForestZipper a +zipper xs = (Nil, xs)++emptyZ :: ForestZipper a+emptyZ = (Nil, Nil)++-- leftZ :: ForestZipper a -> ForestZipper a +-- leftZ (x :> path, xs) = (path, x :> xs)++rightZ :: ForestZipper a -> ForestZipper a+rightZ (path, x `Cons` xs) = (x `Cons` path, xs)++adjustZ :: (Tree a -> Tree a) -> ForestZipper a -> ForestZipper a +adjustZ f (path, x `Cons` xs) = (path, f x `Cons` xs)+adjustZ _ z = z++rezip :: ForestZipper a -> Forest a+rezip (Nil, xs) = xs+rezip (x `Cons` path, xs) = rezip (path, x `Cons` xs)++-- assumes non-empty zipper+rootZ :: ForestZipper a -> a+rootZ (_ , x `Cons` _) = root x+rootZ _ = error "Heap.rootZ: empty zipper"++minZ :: (a -> a -> Bool) -> Forest a -> ForestZipper a +minZ _ Nil = emptyZ+minZ f xs = minZ' f z z+    where z = zipper xs++minZ' :: (a -> a -> Bool) -> ForestZipper a -> ForestZipper a -> ForestZipper a +minZ' _ lo (_, Nil) = lo+minZ' leq lo z = minZ' leq (if leq (rootZ lo) (rootZ z) then lo else z) (rightZ z)++heapify :: (a -> a -> Bool) -> Tree a -> Tree a +heapify _ n@(Node _ _ Nil) = n+heapify leq n@(Node r a as) +    | leq a a' = n+    | otherwise = Node r a' (rezip (left, heapify leq (Node r' a as') `Cons` right))+    where+        (left, Node r' a' as' `Cons` right) = minZ leq as+        + -- | /O(n)/. Build a heap from a list of values. -- -- > size (fromList [1,5,3]) == 3@@ -281,9 +333,13 @@ fromListWith :: (a -> a -> Bool) -> [a] -> Heap a fromListWith f = foldr (insertWith f) mempty +-- | /O(n log n)/. Perform a heap sort+sort :: Ord a => [a] -> [a]+sort = toList . fromList + instance Monoid (Heap a) where     mempty = empty-    mappend = meld+    mappend = union  -- | /O(n)/. Returns the elements in the heap in some arbitrary, very likely unsorted, order. -- @@ -410,14 +466,14 @@         xs = deleteMin h         zs = dropWhile (`leq` x) xs --- | /O(n)/. Construct heaps from each element in another heap, and meld them together.+-- | /O(n)/. Construct heaps from each element in another heap, and union them together. -- -- concatMap (\a -> fromList [a,a+1]) (fromList [1,4]) == fromList [1,2,4,5] concatMap :: Ord b => (a -> Heap b) -> Heap a -> Heap b  concatMap _ Empty = Empty  concatMap f h@(Heap _ _ t) = foldMap f t --- | /O(n log n)/. Group a heap into a heap of heaps, by melding together duplicates.+-- | /O(n log n)/. Group a heap into a heap of heaps, by unioning together duplicates. --  -- > group (fromList "hello") == fromList [fromList "h", fromList "e", fromList "ll", fromList "o"] group :: Heap a -> Heap (Heap a)@@ -526,13 +582,13 @@ uniqify _ Nil = Nil uniqify f (t `Cons` ts) = ins f t ts -meldUniq :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a-meldUniq _ Nil ts = ts-meldUniq _ ts Nil = ts-meldUniq f tts1@(t1 `Cons` ts1) tts2@(t2 `Cons` ts2) = case compare (rank t1) (rank t2) of-        LT -> t1 `Cons` meldUniq f ts1 tts2-        EQ -> ins f (link f t1 t2) (meldUniq f ts1 ts2)-        GT -> t2 `Cons` meldUniq f tts1 ts2+unionUniq :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a+unionUniq _ Nil ts = ts+unionUniq _ ts Nil = ts+unionUniq f tts1@(t1 `Cons` ts1) tts2@(t2 `Cons` ts2) = case compare (rank t1) (rank t2) of+        LT -> t1 `Cons` unionUniq f ts1 tts2+        EQ -> ins f (link f t1 t2) (unionUniq f ts1 ts2)+        GT -> t2 `Cons` unionUniq f tts1 ts2  skewInsert :: (a -> a -> Bool) -> Tree a -> Forest a -> Forest a skewInsert f t ts@(t1 `Cons` t2 `Cons`rest) @@ -541,7 +597,7 @@ skewInsert _ t ts = t `Cons` ts  skewMeld :: (a -> a -> Bool) -> Forest a -> Forest a -> Forest a -skewMeld f ts ts' = meldUniq f (uniqify f ts) (uniqify f ts')+skewMeld f ts ts' = unionUniq f (uniqify f ts) (uniqify f ts')  getMin :: (a -> a -> Bool) -> Forest a -> (Tree a, Forest a)  getMin _ (t `Cons` Nil) = (t, Nil)

@@ -1,5 +1,5 @@ name:           heaps-version:        0.1+version:        0.2 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett