Ticket #3909: pairing-heap.patch

File pairing-heap.patch, 7.6 KB (added by LouisWasserman, 4 years ago)

Pairing heap implementation for comparative benchmarking and to be considered as an alternative. Implemented with a similar interface to Data.PQueue.Min binomial heap.

Line 
1Thu Mar  4 15:48:44 CST 2010  wasserman.louis@gmail.com
2  * Pairing heap for containers
3
4New patches:
5
6[Pairing heap for containers
7wasserman.louis@gmail.com**20100304214844
8 Ignore-this: bc102bf6a34043f16064694b8de74fbe
9] {
10adddir ./Data/PQueue
11addfile ./Data/PQueue/Pairing.hs
12hunk ./Data/PQueue/Pairing.hs 1
13+{-# LANGUAGE CPP #-}
14+
15+-----------------------------------------------------------------------------
16+-- |
17+-- Module      :  Data.MinQueue.Pairing
18+-- Copyright   :  (c) Louis Wasserman 2010
19+-- License     :  BSD-style
20+-- Maintainer  :  libraries@haskell.org
21+-- Stability   :  experimental
22+-- Portability :  portable
23+--
24+-- General-purpose priority queue implementation built on a min-pairing-heap.
25+--
26+-- Currently for comparative benchmarking purposes only.
27+--
28+-----------------------------------------------------------------------------
29+module Data.PQueue.Pairing (empty, singleton, insert, union, extract, delete, toAscList, toList, foldrAsc, foldlAsc,
30+       fromList, fromAscList) where
31+
32+import Control.Applicative hiding (empty)
33+
34+import Data.Maybe
35+import Data.Foldable hiding (toList)
36+import Data.Traversable
37+
38+import Prelude hiding (foldr, foldl)
39+
40+#ifdef __GLASGOW_HASKELL__
41+import GHC.Exts (build)
42+import Text.Read (Lexeme(Ident), lexP, parens, prec,
43+       readPrec, readListPrec, readListPrecDefault)
44+#endif
45+
46+data PQueue a = Empty | PairQ {-# UNPACK #-} !Int {-# UNPACK #-} !(PHeap a)
47+data PHeap a = PHeap a (PChildren a)
48+data PChildren a = Nil | Cons {-# UNPACK #-} !(PHeap a) (PChildren a)
49+
50+instance Functor PHeap where
51+       fmap f (PHeap x ts) = PHeap (f x) (fmap f ts)
52+
53+instance Functor PChildren where
54+       fmap _ Nil = Nil
55+       fmap f (Cons t ts) = Cons (fmap f t) (fmap f ts)
56+
57+instance Functor PQueue where
58+       fmap _ Empty = Empty
59+       fmap f (PairQ n t) = PairQ n (fmap f t)
60+
61+instance Foldable PHeap where
62+       foldr f z (PHeap x ts) = x `f` foldr f z ts
63+       foldl f z (PHeap x ts) = foldl f (z `f` x) ts
64+
65+instance Foldable PChildren where
66+       foldr _ z Nil = z
67+       foldr f z (Cons t ts) = foldr f (foldr f z ts) t
68+       foldl _ z Nil = z
69+       foldl f z (Cons t ts) = foldl f (foldl f z t) ts
70+
71+instance Foldable PQueue where
72+       foldr _ z Empty = z
73+       foldr f z (PairQ _ t) = foldr f z t
74+       foldl _ z Empty = z
75+       foldl f z (PairQ _ t) = foldl f z t
76+
77+instance Traversable PHeap where
78+       traverse f (PHeap x t) = PHeap <$> f x <*> traverse f t
79+
80+instance Traversable PChildren where
81+       traverse _ Nil = pure Nil
82+       traverse f (Cons t ts) = Cons <$> traverse f t <*> traverse f ts
83+
84+instance Traversable PQueue where
85+       traverse _ Empty = pure Empty
86+       traverse f (PairQ n t) = PairQ n <$> traverse f t
87+
88+empty :: PQueue a
89+empty = Empty
90+
91+singleton :: a -> PQueue a
92+singleton = PairQ 1 . tip
93+
94+insert :: Ord a => a -> PQueue a -> PQueue a
95+insert x Empty = singleton x
96+insert x (PairQ n q) = PairQ (n+1) (meldHeap (<=) (tip x) q)
97+
98+union :: Ord a => PQueue a -> PQueue a -> PQueue a
99+Empty `union` q = q
100+q `union` Empty        = q
101+PairQ n1 q1 `union` PairQ n2 q2 = PairQ (n1 + n2) (meldHeap (<=) q1 q2)
102+
103+data ViewQ a = EmptyQ          -- ^ empty queue
104+       | a :^ PQueue a -- ^ the top (minimum) of the queue and the rest of the queue
105+--     deriving (Eq, Ord, Read, Show)
106+
107+extract :: Ord a => PQueue a -> ViewQ a
108+extract Empty = EmptyQ
109+extract (PairQ n (PHeap x ts)) =
110+       x :^ (case meldAll (<=) ts of
111+               Nothing -> Empty
112+               Just q' -> PairQ (n-1) q')
113+
114+delete :: Ord a => PQueue a -> Maybe (PQueue a)
115+delete (PairQ n (PHeap _ ts)) = Just $ maybe Empty (PairQ (n-1)) (meldAll (<=) ts)
116+delete _ = Nothing
117+
118+tip :: e -> PHeap e
119+tip x = PHeap x Nil
120+
121+meldHeap :: (e -> e -> Bool) -> PHeap e -> PHeap e -> PHeap e
122+meldHeap (<=) t1@(PHeap x1 ts1) t2@(PHeap x2 ts2)
123+       | x1 <= x2      = PHeap x1 (t2 `Cons` ts1)
124+       | otherwise     = PHeap x2 (t1 `Cons` ts2)
125+
126+{-# INLINE meldAll #-}
127+meldAll :: (e -> e -> Bool) -> PChildren e -> Maybe (PHeap e)
128+meldAll _ Nil = Nothing
129+meldAll (<=) (Cons t0 ts) = Just (meldAll' (<=) t0 ts)
130+
131+meldAll' :: (e -> e -> Bool) -> PHeap e -> PChildren e -> PHeap e
132+meldAll' (<=) t0 ts = t0 `seq` case ts of
133+       Nil             -> t0
134+       Cons t1 Nil     -> t0 `meld` t1
135+       Cons t1 (Cons t2 ts)
136+                       -> (t0 `meld` t1) `meld` meldAll' (<=) t2 ts
137+       where   meld = meldHeap (<=)
138+
139+{-# INLINE fromAscList #-}
140+fromAscList :: [a] -> PQueue a
141+fromAscList = foldr insMin Empty where
142+       insMin x Empty = singleton x
143+       insMin x (PairQ n t) = PairQ (n+1) (PHeap x (t `Cons` Nil))
144+
145+{-# INLINE fromList #-}
146+fromList :: Ord a => [a] -> PQueue a
147+fromList = foldr insert empty
148+
149+-- toAscList :: Ord a => PQueue a -> [a]
150+-- toAscList
151+
152+foldrAsc :: Ord a => (a -> b -> b) -> b -> PQueue a -> b
153+foldrAsc f z (PairQ _ t) = foldrAscH (<=) f z t
154+foldrAsc _ z _ = z
155+
156+foldrAscH :: (a -> a -> Bool) -> (a -> b -> b) -> b -> PHeap a -> b
157+foldrAscH (<=) f = flip foldH' where
158+       foldH' (PHeap x ts) z = x `f` foldr foldH' z (meldAll (<=) ts)
159+
160+foldlAsc :: Ord a => (b -> a -> b) -> b -> PQueue a -> b
161+foldlAsc f z (PairQ _ t) = foldlAscH (<=) f z t
162+foldlAsc _ z _ = z
163+
164+foldlAscH :: (a -> a -> Bool) -> (b -> a -> b) -> b -> PHeap a -> b
165+foldlAscH (<=) f = foldH' where
166+       foldH' z (PHeap x ts) = foldl foldH' (z `f` x) (meldAll (<=) ts)
167+
168+{-# INLINE toAscList #-}
169+-- | /O(n log n)/.  Extracts the elements of the priority queue in ascending order.
170+toAscList :: Ord a => PQueue a -> [a]
171+#ifdef __GLASGOW_HASKELL__
172+toAscList q = build (\ c nil -> foldrAsc c nil q)
173+#else
174+toAscList = foldrAsc (:) []
175+#endif
176+
177+{-# INLINE toList #-}
178+-- | /O(n)/.  Returns the elements of the priority queue in no particular order.
179+toList :: PQueue a -> [a]
180+#ifdef __GLASGOW_HASKELL__
181+toList q = build (\ c nil -> foldr c nil q)
182+#else
183+toList = foldr (:) []
184+#endif
185hunk ./containers.cabal 36
186             Data.Graph
187             Data.Sequence
188             Data.Tree
189+           Data.PQueue.Pairing
190     }
191     if impl(ghc) {
192         extensions: DeriveDataTypeable, MagicHash, Rank2Types
193}
194
195Context:
196
197[Tweak layout to work with the alternative layout rule
198Ian Lynagh <igloo@earth.li>**20091129154519]
199[Disable building Data.Sequence (and dependents) for nhc98.
200Malcolm.Wallace@cs.york.ac.uk**20091124025653
201 There is some subtlety of polymorphically recursive datatypes and
202 type-class defaulting that nhc98's type system barfs over.
203]
204[Fix another instance of non-ghc breakage.
205Malcolm.Wallace@cs.york.ac.uk**20091123092637]
206[Add #ifdef around ghc-only (<$) as member of Functor class.
207Malcolm.Wallace@cs.york.ac.uk**20091123085155]
208[Fix broken code in non-GHC branch of an ifdef.
209Malcolm.Wallace@cs.york.ac.uk**20091123084824]
210[doc bugfix: correct description of index argument
211Ross Paterson <ross@soi.city.ac.uk>**20091028105532
212 Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9
213 
214 As noted by iaefai on the libraries list.
215 
216 Please merge to STABLE.
217]
218[Bump version to 0.3.0.0
219Ian Lynagh <igloo@earth.li>**20090920141847]
220[update base dependency
221Ross Paterson <ross@soi.city.ac.uk>**20090916073125
222 Ignore-this: ad382ffc6c6a18c15364e6c072f19edb
223 
224 The package uses mkNoRepType and Data.Functor, which were not in the
225 stable branch of base-4.
226]
227[add fast version of <$ for Seq
228Ross Paterson <ross@soi.city.ac.uk>**20090916072812
229 Ignore-this: 5a39a7d31d39760ed589790b1118d240
230]
231[new methods for Data.Sequence (proposal #3271)
232Ross Paterson <ross@soi.city.ac.uk>**20090915173324
233 Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7
234 
235 Adds a lot of new methods to Data.Sequence, mostly paralleling those
236 in Data.List.  Several of these are significantly faster than versions
237 implemented with the previous public interface.  In particular, replicate
238 takes O(log n) time and space instead of O(n).
239 (by Louis Wasserman)
240]
241[Fix "Cabal check" warnings
242Ian Lynagh <igloo@earth.li>**20090811215900]
243[TAG 2009-06-25
244Ian Lynagh <igloo@earth.li>**20090625160202]
245Patch bundle hash:
246876b3b08b202ea8db3fe75e71884c783ea6fc646