# Ticket #3909: pairing-heap.patch

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

Line | |
---|---|

1 | Thu Mar 4 15:48:44 CST 2010 wasserman.louis@gmail.com |

2 | * Pairing heap for containers |

3 | |

4 | New patches: |

5 | |

6 | [Pairing heap for containers |

7 | wasserman.louis@gmail.com**20100304214844 |

8 | Ignore-this: bc102bf6a34043f16064694b8de74fbe |

9 | ] { |

10 | adddir ./Data/PQueue |

11 | addfile ./Data/PQueue/Pairing.hs |

12 | hunk ./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 |

185 | hunk ./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 | |

195 | Context: |

196 | |

197 | [Tweak layout to work with the alternative layout rule |

198 | Ian Lynagh <igloo@earth.li>**20091129154519] |

199 | [Disable building Data.Sequence (and dependents) for nhc98. |

200 | Malcolm.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. |

205 | Malcolm.Wallace@cs.york.ac.uk**20091123092637] |

206 | [Add #ifdef around ghc-only (<$) as member of Functor class. |

207 | Malcolm.Wallace@cs.york.ac.uk**20091123085155] |

208 | [Fix broken code in non-GHC branch of an ifdef. |

209 | Malcolm.Wallace@cs.york.ac.uk**20091123084824] |

210 | [doc bugfix: correct description of index argument |

211 | Ross 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 |

219 | Ian Lynagh <igloo@earth.li>**20090920141847] |

220 | [update base dependency |

221 | Ross 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 |

228 | Ross Paterson <ross@soi.city.ac.uk>**20090916072812 |

229 | Ignore-this: 5a39a7d31d39760ed589790b1118d240 |

230 | ] |

231 | [new methods for Data.Sequence (proposal #3271) |

232 | Ross 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 |

242 | Ian Lynagh <igloo@earth.li>**20090811215900] |

243 | [TAG 2009-06-25 |

244 | Ian Lynagh <igloo@earth.li>**20090625160202] |

245 | Patch bundle hash: |

246 | 876b3b08b202ea8db3fe75e71884c783ea6fc646 |