# Ticket #3909: containers-pqueue.4.patch

File containers-pqueue.4.patch, 36.6 KB (added by LouisWasserman, 7 years ago) |
---|

Line | |
---|---|

1 | Sun Mar 7 16:03:56 CST 2010 wasserman.louis@gmail.com |

2 | * Priority queues for containers |

3 | |

4 | New patches: |

5 | |

6 | [Priority queues for containers |

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

8 | Ignore-this: 4251d1476441ffd89c2c0e62bb102ebc |

9 | ] { |

10 | adddir ./Data/PQueue |

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

12 | hunk ./Data/PQueue/Max.hs 1 |

13 | +{-# LANGUAGE CPP #-} |

14 | hunk ./Data/PQueue/Max.hs 3 |

15 | +----------------------------------------------------------------------------- |

16 | +-- | |

17 | +-- Module : Data.PQueue.Max |

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, supporting extract-maximum operations. |

25 | +-- |

26 | +-- An amortized running time is given for each operation, with /n/ referring |

27 | +-- to the length of the sequence and /i/ being the integral index used by |

28 | +-- some operations. These bounds hold even in a persistent (shared) setting. |

29 | +-- |

30 | +-- This implementation is based on a binomial heap augmented with a global root. |

31 | +-- The spine of the heap is maintained strictly, ensuring that computations happen |

32 | +-- as they are performed. Note that this module is a small wrapper around |

33 | +-- "Data.PQueue.Min". |

34 | +-- |

35 | +-- /WARNING:/ 'toList' and 'toDescList' are /not/ equivalent, unlike for example |

36 | +-- "Data.Map". |

37 | +----------------------------------------------------------------------------- |

38 | +module Data.PQueue.Max( |

39 | + MaxQueue, |

40 | + -- * Basic operations |

41 | + empty, |

42 | + null, |

43 | + size, |

44 | + -- * Query operations |

45 | + ViewQ(..), |

46 | + top, |

47 | + delete, |

48 | + extract, |

49 | + -- * Construction operations |

50 | + singleton, |

51 | + insert, |

52 | + union, |

53 | + unions, |

54 | + -- * Extracting elements |

55 | + (!!), |

56 | + take, |

57 | + drop, |

58 | + splitAt, |

59 | + takeWhile, |

60 | + dropWhile, |

61 | + span, |

62 | + break, |

63 | + filter, |

64 | + partition, |

65 | + -- * Fold\/Functor\/Traversable variations |

66 | + mapMonotonic, |

67 | + foldrDesc, |

68 | + foldlDesc, |

69 | + traverseMonotonic, |

70 | + -- * List operations |

71 | + toList, |

72 | + toDescList, |

73 | + fromList, |

74 | + fromDescList) where |

75 | + |

76 | +import Control.Applicative (Applicative(..), (<$>)) |

77 | + |

78 | +import Data.Monoid |

79 | +import Data.Foldable hiding (toList) |

80 | +import Data.Traversable |

81 | +import Data.Ord |

82 | + |

83 | +import qualified Data.PQueue.Min as Min |

84 | + |

85 | +import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter) |

86 | + |

87 | +#ifdef __GLASGOW_HASKELL__ |

88 | +import GHC.Exts (build) |

89 | +import Text.Read (Lexeme(Ident), lexP, parens, prec, |

90 | + readPrec, readListPrec, readListPrecDefault) |

91 | +#endif |

92 | + |

93 | +-- | A priority queue implementation. Implemented as a wrapper around "Data.PQueue.Min". |

94 | +-- /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/. |

95 | +-- For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid |

96 | +-- 'MaxQueue' will return a valid 'MaxQueue'. An analogous guarantee holds for 'traverse'. (Note: |

97 | +-- if passed constant-time operations, every function in 'Functor', 'Foldable', and 'Traversable' |

98 | +-- will run in /O(n)/.) |

99 | +-- |

100 | +-- If you wish to perform folds on a priority queue that respect order, use 'foldrDesc' or |

101 | +-- 'foldlDesc'. |

102 | +newtype MaxQueue a = MaxQ {unMaxQ :: Min.MinQueue (Down a)} |

103 | +newtype Down a = Down {unDown :: a} deriving (Eq) |

104 | + |

105 | +instance Ord a => Ord (Down a) where |

106 | + Down x `compare` Down y = compare y x |

107 | + Down x <= Down y = y <= x |

108 | + Down x < Down y = y < x |

109 | + Down x >= Down y = y >= x |

110 | + Down x > Down y = y > x |

111 | + |

112 | +instance Ord a => Eq (MaxQueue a) where |

113 | + MaxQ q1 == MaxQ q2 = q1 == q2 |

114 | + |

115 | +instance Ord a => Ord (MaxQueue a) where |

116 | + MaxQ q1 `compare` MaxQ q2 = q1 `compare` q2 |

117 | + |

118 | +instance (Ord a, Show a) => Show (MaxQueue a) where |

119 | + showsPrec p xs = showParen (p > 10) $ |

120 | + showString "fromDescList " . shows (toDescList xs) |

121 | + |

122 | +instance Read a => Read (MaxQueue a) where |

123 | +#ifdef __GLASGOW_HASKELL__ |

124 | + readPrec = parens $ prec 10 $ do |

125 | + Ident "fromDescList" <- lexP |

126 | + xs <- readPrec |

127 | + return (fromDescList xs) |

128 | + |

129 | + readListPrec = readListPrecDefault |

130 | +#else |

131 | + readsPrec p = readParen (p > 10) $ \ r -> do |

132 | + ("fromDescList",s) <- lex r |

133 | + (xs,t) <- reads s |

134 | + return (fromDescList xs,t) |

135 | +#endif |

136 | + |

137 | +instance Ord a => Monoid (MaxQueue a) where |

138 | + mempty = empty |

139 | + mappend = union |

140 | + |

141 | +-- | /O(1)/. The empty priority queue. |

142 | +empty :: MaxQueue a |

143 | +empty = MaxQ Min.empty |

144 | + |

145 | +-- | /O(1)/. Is this the empty priority queue? |

146 | +null :: MaxQueue a -> Bool |

147 | +null (MaxQ q) = Min.null q |

148 | + |

149 | +-- | /O(1)/. The number of elements in the queue. |

150 | +size :: MaxQueue a -> Int |

151 | +size (MaxQ q) = Min.size q |

152 | + |

153 | +data ViewQ a = EmptyQ -- ^ empty queue |

154 | + | a :^ MaxQueue a -- ^ the top (maximum) of the queue and the rest of the queue |

155 | + deriving (Eq, Ord, Read, Show) |

156 | + |

157 | +instance Functor ViewQ where |

158 | + fmap f (a :^ q) = f a :^ fmap f q |

159 | + fmap _ _ = EmptyQ |

160 | + |

161 | +instance Foldable ViewQ where |

162 | + foldr _ z EmptyQ = z |

163 | + foldr f z (a :^ q) = a `f` foldr f z q |

164 | + foldl _ z EmptyQ = z |

165 | + foldl f z (a :^ q) = foldl f (z `f` a) q |

166 | + |

167 | +instance Traversable ViewQ where |

168 | + traverse _ EmptyQ = pure EmptyQ |

169 | + traverse f (a :^ q) = (:^) <$> f a <*> traverse f q |

170 | + |

171 | +-- | /O(log n)/. The top (maximum) element of the queue, if there is one. |

172 | +top :: Ord a => MaxQueue a -> Maybe a |

173 | +top q = case extract q of |

174 | + EmptyQ -> Nothing |

175 | + x :^ _ -> Just x |

176 | + |

177 | +-- | /O(log n)/. Extract the top (maximum) element of the sequence, if there is one. |

178 | +extract :: Ord a => MaxQueue a -> ViewQ a |

179 | +extract (MaxQ q) = case Min.extract q of |

180 | + Min.EmptyQ -> EmptyQ |

181 | + (Min.:^) (Down a) q' |

182 | + -> a :^ MaxQ q' |

183 | + |

184 | +-- | /O(log n)/. Delete the top (maximum) element of the sequence, if there is one. |

185 | +delete :: Ord a => MaxQueue a -> Maybe (MaxQueue a) |

186 | +delete (MaxQ q) = MaxQ <$> Min.delete q |

187 | + |

188 | +-- | /O(1)/. Construct a priority queue with a single element. |

189 | +singleton :: a -> MaxQueue a |

190 | +singleton = MaxQ . Min.singleton . Down |

191 | + |

192 | +-- | /O(1)/. Insert an element into the priority queue. |

193 | +insert :: Ord a => a -> MaxQueue a -> MaxQueue a |

194 | +insert x (MaxQ q) = MaxQ (Min.insert (Down x) q) |

195 | + |

196 | +-- | /O(log (min(n,m)))/. Take the union of two priority queues. |

197 | +union :: Ord a => MaxQueue a -> MaxQueue a -> MaxQueue a |

198 | +MaxQ q1 `union` MaxQ q2 = MaxQ (Min.union q1 q2) |

199 | + |

200 | +-- | Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@. |

201 | +unions :: Ord a => [MaxQueue a] -> MaxQueue a |

202 | +unions = foldl union empty |

203 | + |

204 | +-- | /O(k log n)/. Returns the @(k+1)@th largest element of the queue. |

205 | +(!!) :: Ord a => MaxQueue a -> Int -> a |

206 | +MaxQ q !! n = unDown ((Min.!!) q n) |

207 | + |

208 | +{-# INLINE take #-} |

209 | +-- | /O(k log n)/. Returns the list of the @k@ largest elements of the queue, in descending order, or |

210 | +-- all elements of the queue, if @k >= n@. |

211 | +take :: Ord a => Int -> MaxQueue a -> [a] |

212 | +take k (MaxQ q) = [a | Down a <- Min.take k q] |

213 | + |

214 | +-- | /O(k log n)/. Returns the queue with the @k@ largest elements deleted, or the empty queue if @k >= n@. |

215 | +drop :: Ord a => Int -> MaxQueue a -> MaxQueue a |

216 | +drop k (MaxQ q) = MaxQ (Min.drop k q) |

217 | + |

218 | +-- | /O(k log n)/. Equivalent to @(take k queue, drop k queue)@. |

219 | +splitAt :: Ord a => Int -> MaxQueue a -> ([a], MaxQueue a) |

220 | +splitAt k (MaxQ q) = (map unDown xs, MaxQ q') where |

221 | + (xs, q') = Min.splitAt k q |

222 | + |

223 | +-- | 'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the |

224 | +-- longest prefix (possibly empty) of @queue@ of elements that satisfy @p@. |

225 | +takeWhile :: Ord a => (a -> Bool) -> MaxQueue a -> [a] |

226 | +takeWhile p (MaxQ q) = map unDown (Min.takeWhile (p . unDown) q) |

227 | + |

228 | +-- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. |

229 | +-- |

230 | +dropWhile :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a |

231 | +dropWhile p (MaxQ q) = MaxQ (Min.dropWhile (p . unDown) q) |

232 | + |

233 | +-- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where |

234 | +-- first element is longest prefix (possibly empty) of @queue@ of elements that |

235 | +-- satisfy @p@ and second element is the remainder of the queue. |

236 | +-- |

237 | +span :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a) |

238 | +span p (MaxQ q) = (map unDown xs, MaxQ q') where |

239 | + (xs, q') = Min.span (p . unDown) q |

240 | + |

241 | +-- | 'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where |

242 | +-- first element is longest prefix (possibly empty) of @queue@ of elements that |

243 | +-- /do not satisfy/ @p@ and second element is the remainder of the queue. |

244 | +break :: Ord a => (a -> Bool) -> MaxQueue a -> ([a], MaxQueue a) |

245 | +break p = span (not . p) |

246 | + |

247 | +filter :: Ord a => (a -> Bool) -> MaxQueue a -> MaxQueue a |

248 | +filter p (MaxQ q) = MaxQ (Min.filter (p . unDown) q) |

249 | + |

250 | +partition :: Ord a => (a -> Bool) -> MaxQueue a -> (MaxQueue a, MaxQueue a) |

251 | +partition p (MaxQ q) = (MaxQ q0, MaxQ q1) |

252 | + where (q0, q1) = Min.partition (p . unDown) q |

253 | + |

254 | +-- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue, |

255 | +-- as in 'fmap'. If it is not, the result is undefined. |

256 | +mapMonotonic :: (a -> b) -> MaxQueue a -> MaxQueue b |

257 | +mapMonotonic = fmap |

258 | + |

259 | +-- | /O(n)/. Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation. |

260 | +-- If the function is not monotonic, the result is undefined. |

261 | +traverseMonotonic :: Applicative f => (a -> f b) -> MaxQueue a -> f (MaxQueue b) |

262 | +traverseMonotonic = traverse |

263 | + |

264 | +instance Functor Down where |

265 | + fmap f (Down a) = Down (f a) |

266 | + |

267 | +instance Foldable Down where |

268 | + foldr f z (Down a) = a `f` z |

269 | + foldl f z (Down a) = z `f` a |

270 | + |

271 | +instance Traversable Down where |

272 | + traverse f (Down a) = Down <$> f a |

273 | + |

274 | +instance Functor MaxQueue where |

275 | + fmap f (MaxQ q) = MaxQ (fmap (fmap f) q) |

276 | + |

277 | +instance Foldable MaxQueue where |

278 | + foldr f z (MaxQ q) = foldr (flip (foldr f)) z q |

279 | + foldl f z (MaxQ q) = foldl (foldl f) z q |

280 | + |

281 | +instance Traversable MaxQueue where |

282 | + traverse f (MaxQ q) = MaxQ <$> traverse (traverse f) q |

283 | + |

284 | +-- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in descending order. |

285 | +foldrDesc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b |

286 | +foldrDesc f z (MaxQ q) = Min.foldrAsc (flip (foldr f)) z q |

287 | + |

288 | +-- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in descending order. |

289 | +foldlDesc :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b |

290 | +foldlDesc f z (MaxQ q) = Min.foldlAsc (foldl f) z q |

291 | + |

292 | +{-# INLINE toDescList #-} |

293 | +-- | /O(n log n)/. Extracts the elements of the priority queue in descending order. |

294 | +toDescList :: Ord a => MaxQueue a -> [a] |

295 | +#ifdef __GLASGOW_HASKELL__ |

296 | +toDescList q = build (\ c nil -> foldrDesc c nil q) |

297 | +#else |

298 | +toDescList = foldrDesc (:) [] |

299 | +#endif |

300 | + |

301 | +{-# INLINE toList #-} |

302 | +-- | /O(n)/. Returns the elements of the priority queue in no particular order. |

303 | +toList :: MaxQueue a -> [a] |

304 | +#ifdef __GLASGOW_HASKELL__ |

305 | +toList q = build (\ c nil -> foldr c nil q) |

306 | +#else |

307 | +toList = foldr (:) [] |

308 | +#endif |

309 | + |

310 | +{-# INLINE fromDescList #-} |

311 | +-- | /O(n)/. Constructs a priority queue from an descending list. /Warning/: Does not check the precondition. |

312 | +fromDescList :: [a] -> MaxQueue a |

313 | +fromDescList = MaxQ . Min.fromAscList . map Down |

314 | + |

315 | +{-# INLINE fromList #-} |

316 | +-- | /O(n log n)/. Constructs a priority queue from an unordered list. |

317 | +fromList :: Ord a => [a] -> MaxQueue a |

318 | +fromList = foldr insert empty |

319 | addfile ./Data/PQueue/Min.hs |

320 | hunk ./Data/PQueue/Min.hs 1 |

321 | +{-# LANGUAGE CPP #-} |

322 | hunk ./Data/PQueue/Min.hs 3 |

323 | +----------------------------------------------------------------------------- |

324 | +-- | |

325 | +-- Module : Data.PQueue.Min |

326 | +-- Copyright : (c) Louis Wasserman 2010 |

327 | +-- License : BSD-style |

328 | +-- Maintainer : libraries@haskell.org |

329 | +-- Stability : experimental |

330 | +-- Portability : portable |

331 | +-- |

332 | +-- General purpose priority queue, supporting extract-minimum operations. |

333 | +-- |

334 | +-- An amortized running time is given for each operation, with /n/ referring |

335 | +-- to the length of the sequence and /i/ being the integral index used by |

336 | +-- some operations. These bounds hold even in a persistent (shared) setting. |

337 | +-- |

338 | +-- This implementation is based on a binomial heap augmented with a global root. |

339 | +-- The spine of the heap is maintained strictly, ensuring that computations happen |

340 | +-- as they are performed. |

341 | +-- |

342 | +-- /WARNING:/ 'toList' and 'toAscList' are /not/ equivalent, unlike for example |

343 | +-- "Data.Map". |

344 | +----------------------------------------------------------------------------- |

345 | +module Data.PQueue.Min ( |

346 | + MinQueue, |

347 | + -- * Basic operations |

348 | + empty, |

349 | + null, |

350 | + size, |

351 | + -- * Query operations |

352 | + ViewQ(..), |

353 | + top, |

354 | + delete, |

355 | + extract, |

356 | + -- * Construction operations |

357 | + singleton, |

358 | + insert, |

359 | + union, |

360 | + unions, |

361 | + -- * Extracting elements |

362 | + (!!), |

363 | + take, |

364 | + drop, |

365 | + splitAt, |

366 | + takeWhile, |

367 | + dropWhile, |

368 | + span, |

369 | + break, |

370 | + filter, |

371 | + partition, |

372 | +-- filter1, |

373 | + -- * Fold\/Functor\/Traversable variations |

374 | + mapMonotonic, |

375 | + foldrAsc, |

376 | + foldlAsc, |

377 | + traverseMonotonic, |

378 | + -- * List operations |

379 | + toList, |

380 | + toAscList, |

381 | + fromList, |

382 | + fromAscList) where |

383 | + |

384 | +import Prelude hiding (null, foldr, foldl, take, drop, takeWhile, dropWhile, splitAt, span, break, (!!), filter) |

385 | + |

386 | +import Control.Applicative (Applicative(..), (<$>)) |

387 | + |

388 | +import Data.Monoid |

389 | +import Data.Foldable hiding (toList) |

390 | +import Data.Traversable |

391 | + |

392 | +import qualified Data.List as List |

393 | + |

394 | +#ifdef __GLASGOW_HASKELL__ |

395 | +import GHC.Exts (build) |

396 | +import Text.Read (Lexeme(Ident), lexP, parens, prec, |

397 | + readPrec, readListPrec, readListPrecDefault) |

398 | +#else |

399 | + |

400 | +build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a] |

401 | +build f = f (:) [] |

402 | + |

403 | +#endif |

404 | + |

405 | +-- | A priority queue implementation. Implemented as a find-min wrapper around a binomial heap. |

406 | +-- /Warning/: the 'Functor', 'Foldable', and 'Traversable' instances of this type /ignore ordering/. |

407 | +-- For 'Functor', it is guaranteed that if @f@ is a monotonic function, then @'fmap' f@ on a valid |

408 | +-- 'MinQueue' will return a valid 'MinQueue'. An analogous guarantee holds for 'traverse'. (Note: |

409 | +-- if passed constant-time operations, every function in 'Functor', 'Foldable', and 'Traversable' |

410 | +-- will run in /O(n)/.) |

411 | +-- |

412 | +-- If you wish to perform folds on a priority queue that respect order, use 'foldrAsc' or |

413 | +-- 'foldlAsc'. |

414 | +-- |

415 | +-- For any operation @op@ in 'Eq' or 'Ord', @queue1 `op` queue2@ is equivalent to |

416 | +-- @toAscList queue1 `op` toAscList queue2@. |

417 | +data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a) |

418 | +type BinomHeap a = BinomForest a Zero |

419 | + |

420 | +instance Ord a => Eq (MinQueue a) where |

421 | + Empty == Empty = True |

422 | + MinQueue n1 x1 q1 == MinQueue n2 x2 q2 |

423 | + = n1 == n2 && x1 == x2 && foldr (&&) True (zipWith (==) (toAscL q1) (toAscL q2)) |

424 | + _ == _ = False |

425 | + |

426 | +instance Ord a => Ord (MinQueue a) where |

427 | + Empty `compare` Empty = EQ |

428 | + Empty `compare` _ = LT |

429 | + _ `compare` Empty = GT |

430 | + MinQueue n1 x1 q1 `compare` MinQueue n2 x2 q2 = |

431 | + compare x1 x2 `mappend` foldr mappend (compare n1 n2) (zipWith compare (toAscL q1) (toAscL q2)) |

432 | + -- We compare their first elements, then their other elements up to the smaller queue's length, |

433 | + -- and then the longer queue wins. |

434 | + -- This is equivalent to @comparing toAscList@, except it fuses much more nicely. |

435 | + |

436 | +instance (Ord a, Show a) => Show (MinQueue a) where |

437 | + showsPrec p xs = showParen (p > 10) $ |

438 | + showString "fromAscList " . shows (toAscList xs) |

439 | + |

440 | +instance Read a => Read (MinQueue a) where |

441 | +#ifdef __GLASGOW_HASKELL__ |

442 | + readPrec = parens $ prec 10 $ do |

443 | + Ident "fromAscList" <- lexP |

444 | + xs <- readPrec |

445 | + return (fromAscList xs) |

446 | + |

447 | + readListPrec = readListPrecDefault |

448 | +#else |

449 | + readsPrec p = readParen (p > 10) $ \ r -> do |

450 | + ("fromAscList",s) <- lex r |

451 | + (xs,t) <- reads s |

452 | + return (fromAscList xs,t) |

453 | +#endif |

454 | + |

455 | +instance Ord a => Monoid (MinQueue a) where |

456 | + mempty = Empty |

457 | + mappend = union |

458 | + |

459 | +-- We implement tree ranks in the type system with a nicely elegant approach, as follows. |

460 | +-- The goal is to have the type system automatically guarantee that our binomial forest |

461 | +-- has the correct binomial structure. |

462 | +-- |

463 | +-- In the traditional set-theoretic construction of the natural numbers, we define |

464 | +-- each number to be the set of numbers less than it, and zero to be the empty set, |

465 | +-- as follows: |

466 | +-- |

467 | +-- 0 = {} 1 = {0} 2 = {0, 1} 3={0, 1, 2} ... |

468 | +-- |

469 | +-- Binomial trees have a similar structure: a tree of rank @k@ has one child of each |

470 | +-- rank less than @k@. Let's define the type @rk@ corresponding to rank @k@ to refer |

471 | +-- to a collection of binomial trees of ranks @0..k-1@. Then we can say that |

472 | +-- |

473 | +-- > data Succ e rk = Succ (BinomTree e rk) rk |

474 | +-- |

475 | +-- and this behaves exactly as the successor operator for ranks should behave. Furthermore, |

476 | +-- we immediately obtain that |

477 | +-- |

478 | +-- > data BinomTree e rk = BinomTree e rk |

479 | +-- |

480 | +-- which is nice and compact. |

481 | +data BinomForest e rk = Nil | Skip !(BinomForest' e rk) | Cons {-# UNPACK #-} !(BinomTree e rk) !(BinomForest' e rk) |

482 | +type BinomForest' e rk = BinomForest e (Succ e rk) |

483 | + |

484 | +instance Ord e => Monoid (BinomForest e rk) where |

485 | + mempty = Nil |

486 | + mappend = merge (<=) |

487 | + |

488 | +data BinomTree e rk = BinomTree e rk |

489 | +type BinomTree' e rk = BinomTree e (Succ e rk) |

490 | +data Succ e rk = Succ {-# UNPACK #-} !(BinomTree e rk) rk |

491 | +type Zero = () |

492 | + |

493 | +-- basics |

494 | + |

495 | +-- | /O(1)/. The empty priority queue. |

496 | +empty :: MinQueue a |

497 | +empty = Empty |

498 | + |

499 | +-- | /O(1)/. Is this the empty priority queue? |

500 | +null :: MinQueue a -> Bool |

501 | +null Empty = True |

502 | +null _ = False |

503 | + |

504 | +-- | /O(1)/. The number of elements in the queue. |

505 | +size :: MinQueue a -> Int |

506 | +size Empty = 0 |

507 | +size (MinQueue n _ _) = n |

508 | + |

509 | +-- queries |

510 | + |

511 | +-- | View of the top of a sequence. Note: the 'Functor', 'Foldable', and 'Traversable' instances |

512 | +-- have the same caveats as the instances for 'MinQueue'. |

513 | +data ViewQ a = EmptyQ -- ^ empty queue |

514 | + | a :^ MinQueue a -- ^ the top (minimum) of the queue and the rest of the queue |

515 | + deriving (Eq, Ord, Read, Show) |

516 | + |

517 | +instance Functor ViewQ where |

518 | + fmap f (a :^ q) = f a :^ fmap f q |

519 | + fmap _ _ = EmptyQ |

520 | + |

521 | +instance Foldable ViewQ where |

522 | + foldr _ z EmptyQ = z |

523 | + foldr f z (a :^ q) = a `f` foldr f z q |

524 | + foldl _ z EmptyQ = z |

525 | + foldl f z (a :^ q) = foldl f (z `f` a) q |

526 | + |

527 | +instance Traversable ViewQ where |

528 | + traverse _ EmptyQ = pure EmptyQ |

529 | + traverse f (a :^ q) = (:^) <$> f a <*> traverse f q |

530 | + |

531 | +-- | /O(1)/. View the top (minimum) element of the queue, if there is one. |

532 | +top :: Ord a => MinQueue a -> Maybe a |

533 | +top q = case extract q of |

534 | + EmptyQ -> Nothing |

535 | + x :^ _ -> Just x |

536 | + |

537 | +-- | /O(log n)/. Delete the top element of the sequence, if there is one. |

538 | +delete :: Ord a => MinQueue a -> Maybe (MinQueue a) |

539 | +delete q = case extract q of |

540 | + EmptyQ -> Nothing |

541 | + _ :^ q' -> Just q' |

542 | + |

543 | +-- | /O(log n)/. Extract the top (minimum) element of the sequence, if there is one. |

544 | +extract :: Ord a => MinQueue a -> ViewQ a |

545 | +extract Empty = EmptyQ |

546 | +extract (MinQueue n x f) = x :^ extractHeap n f |

547 | + |

548 | +-- | /O(1)/. Construct a priority queue with a single element. |

549 | +singleton :: a -> MinQueue a |

550 | +singleton x = MinQueue 1 x Nil |

551 | + |

552 | +-- | /O(1)/. Insert an element into the priority queue. |

553 | +insert :: Ord a => a -> MinQueue a -> MinQueue a |

554 | +insert x' (MinQueue n x f) |

555 | + | x' <= x = MinQueue (n+1) x' (insertBin x f) |

556 | + | otherwise = MinQueue (n+1) x (insertBin x' f) |

557 | + where insertBin = carry1 (<=) . tip |

558 | +insert x Empty = singleton x |

559 | + |

560 | +-- | /O(log (min(n,m)))/. Take the union of two priority queues. |

561 | +union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a |

562 | +union = union' (<=) |

563 | + |

564 | +-- | Takes the union of a list of priority queues. Equivalent to @'foldl' 'union' 'empty'@. |

565 | +unions :: Ord a => [MinQueue a] -> MinQueue a |

566 | +unions = foldl union Empty |

567 | + |

568 | +-- | Index (subscript) operator, starting from 0. @queue !! k@ returns the @(k+1)@th smallest element in the queue. |

569 | +(!!) :: Ord a => MinQueue a -> Int -> a |

570 | +q !! n | n < 0 = error "Data.PQueue.Min.!!: negative index" |

571 | + | n >= size q |

572 | + = error "Data.PQueue.Min.!!: index too large" |

573 | +q !! n = (List.!!) (toAscList q) n |

574 | + |

575 | +{-# INLINE takeWhile #-} |

576 | +-- | 'takeWhile', applied to a predicate @p@ and a queue @queue@, returns the |

577 | +-- longest prefix (possibly empty) of @queue@ of elements that satisfy @p@. |

578 | +takeWhile :: Ord a => (a -> Bool) -> MinQueue a -> [a] |

579 | +#ifdef __GLASGOW_HASKELL__ |

580 | +takeWhile p queue = build (\ c nil -> |

581 | + let takeW queue = case extract queue of |

582 | + x :^ queue' |

583 | + | p x -> x `c` takeW queue' |

584 | + _ -> nil |

585 | + in takeW queue) |

586 | +#else |

587 | +takeWhile p = List.takeWhile p . toAscList |

588 | +#endif |

589 | + |

590 | +-- | 'dropWhile' @p queue@ returns the queue remaining after 'takeWhile' @p queue@. |

591 | +dropWhile :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a |

592 | +dropWhile p queue = case extract queue of |

593 | + x :^ queue' |

594 | + | p x -> dropWhile p queue' |

595 | + _ -> queue |

596 | + |

597 | +-- | 'span', applied to a predicate @p@ and a queue @queue@, returns a tuple where |

598 | +-- first element is longest prefix (possibly empty) of @queue@ of elements that |

599 | +-- satisfy @p@ and second element is the remainder of the queue. |

600 | +span :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a) |

601 | +span p queue = case extract queue of |

602 | + x :^ q' | p x -> let (ys, q'') = span p q' in (x:ys, q'') |

603 | + _ -> ([], queue) |

604 | + |

605 | +-- | 'break', applied to a predicate @p@ and a queue @queue@, returns a tuple where |

606 | +-- first element is longest prefix (possibly empty) of @queue@ of elements that |

607 | +-- /do not satisfy/ @p@ and second element is the remainder of the queue. |

608 | +break :: Ord a => (a -> Bool) -> MinQueue a -> ([a], MinQueue a) |

609 | +break p = span (not . p) |

610 | + |

611 | +{-# INLINE take #-} |

612 | +-- | /O(k log n)/. 'take' @k@, applied to a queue @queue@, returns a list of the smallest @k@ elements of @queue@, |

613 | +-- or all elements of @queue@ itself if @k >= 'size' queue@. |

614 | +take :: Ord a => Int -> MinQueue a -> [a] |

615 | +take n = List.take n . toAscList |

616 | + |

617 | +-- | /O(k log n)/. 'drop' @k@, applied to a queue @queue@, returns @queue@ with the smallest @k@ elements deleted, |

618 | +-- or an empty queue if @k >= size 'queue'@. |

619 | +drop :: Ord a => Int -> MinQueue a -> MinQueue a |

620 | +drop n queue = n `seq` case delete queue of |

621 | + Just queue' |

622 | + | n > 0 -> drop (n-1) queue' |

623 | + _ -> queue |

624 | + |

625 | +-- | /O(k log n)/. Equivalent to @('take' k queue, 'drop' k queue)@. |

626 | +splitAt :: Ord a => Int -> MinQueue a -> ([a], MinQueue a) |

627 | +splitAt n queue = n `seq` case extract queue of |

628 | + x :^ queue' |

629 | + | n >= 0 -> let (xs, queue'') = splitAt (n-1) queue' in (x:xs, queue'') |

630 | + _ -> ([], queue) |

631 | + |

632 | +-- | /O(n)/. Returns the queue with all elements not satisfying @p@ removed. |

633 | +filter :: Ord a => (a -> Bool) -> MinQueue a -> MinQueue a |

634 | +filter _ Empty = Empty |

635 | +filter p (MinQueue _ x ts) = filterQueue p (<=) (const Empty) (if p x then singleton x else Empty) ts |

636 | + |

637 | +partition :: Ord a => (a -> Bool) -> MinQueue a -> (MinQueue a, MinQueue a) |

638 | +partition _ Empty = (Empty, Empty) |

639 | +partition p (MinQueue _ x ts) |

640 | + = partitionQueue p (<=) (const (Empty, Empty)) qs0 ts |

641 | + where qs0 = if p x then (singleton x, Empty) else (Empty, singleton x) |

642 | + |

643 | +-- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue, |

644 | +-- as in 'fmap'. If it is not, the result is undefined. |

645 | +mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b |

646 | +mapMonotonic = fmap |

647 | + |

648 | +-- | /O(n)/. Assumes that the function it is given is monotonic, in some sense, and performs the 'traverse' operation. |

649 | +-- If the function is not monotonic, the result is undefined. |

650 | +traverseMonotonic :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b) |

651 | +traverseMonotonic = traverse |

652 | + |

653 | +{-# INLINE toAscList #-} |

654 | +-- | /O(n log n)/. Extracts the elements of the priority queue in ascending order. |

655 | +toAscList :: Ord a => MinQueue a -> [a] |

656 | +#ifdef __GLASGOW_HASKELL__ |

657 | +toAscList q = build (\ c nil -> foldrAsc c nil q) |

658 | +#else |

659 | +toAscList = foldrAsc (:) [] |

660 | +#endif |

661 | + |

662 | +{-# INLINE toList #-} |

663 | +-- | /O(n)/. Returns the elements of the priority queue in no particular order. |

664 | +toList :: MinQueue a -> [a] |

665 | +#ifdef __GLASGOW_HASKELL__ |

666 | +toList q = build (\ c nil -> foldr c nil q) |

667 | +#else |

668 | +toList = foldr (:) [] |

669 | +#endif |

670 | + |

671 | +-- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in ascending order. |

672 | +foldrAsc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b |

673 | +foldrAsc c n (MinQueue _ x f) = x `c` foldrOrd (<=) c n f |

674 | +foldrAsc _ n _ = n |

675 | + |

676 | +-- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in ascending order. |

677 | +foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b |

678 | +foldlAsc f z (MinQueue _ x forest) = foldlOrd (<=) f (z `f` x) forest |

679 | +foldlAsc _ z _ = z |

680 | + |

681 | +{-# INLINE fromList #-} |

682 | +-- | /O(n log n)/. Constructs a priority queue from an unordered list. |

683 | +fromList :: Ord a => [a] -> MinQueue a |

684 | +fromList = foldr insert Empty |

685 | + |

686 | +{-# INLINE fromAscList #-} |

687 | +-- | /O(n)/. Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition. |

688 | +fromAscList :: [a] -> MinQueue a |

689 | +fromAscList = foldr insertMinQ Empty |

690 | + |

691 | +{-# INLINE union' #-} |

692 | +union' :: (a -> a -> Bool) -> MinQueue a -> MinQueue a -> MinQueue a |

693 | +union' _ Empty q = q |

694 | +union' _ q Empty = q |

695 | +union' (<=) (MinQueue n1 x1 f1) (MinQueue n2 x2 f2) |

696 | + | x1 <= x2 = MinQueue (n1 + n2) x1 (carry (<=) (tip x2) f1 f2) |

697 | + | otherwise = MinQueue (n1 + n2) x2 (carry (<=) (tip x1) f1 f2) |

698 | + |

699 | +-- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root. |

700 | +extractHeap :: Ord a => Int -> BinomHeap a -> MinQueue a |

701 | +extractHeap n f = n `seq` case extractBin (<=) f of |

702 | + NoExtract -> Empty |

703 | + YesExtract x' _ f' |

704 | + -> MinQueue (n-1) x' f' |

705 | + |

706 | +-- | A specialized type intended to organize the return of extract-min queries |

707 | +-- from a binomial forest. We walk all the way through the forest, and then |

708 | +-- walk backwards. @Extract e rk@ is the result type of an extract-min |

709 | +-- operation that has walked as far backwards of rank @rk@ -- that is, it |

710 | +-- has visited every root of rank @>= rk@. |

711 | +-- |

712 | +-- The interpretation of @YesExtract minKey children forest@ is |

713 | +-- |

714 | +-- * @minKey@ is the key of the minimum root visited so far. It may have |

715 | +-- any rank @>= rk@. We will denote the root corresponding to |

716 | +-- @minKey@ as @minRoot@. |

717 | +-- |

718 | +-- * @children@ is those children of @minRoot@ which have not yet been |

719 | +-- merged with the rest of the forest. Specifically, these are |

720 | +-- the children with rank @< rk@. |

721 | +-- |

722 | +-- * @forest@ is an accumulating parameter that maintains the partial |

723 | +-- reconstruction of the binomial forest without @minRoot@. It is |

724 | +-- the union of all old roots with rank @>= rk@ (except @minRoot@), |

725 | +-- with the set of all children of @minRoot@ with rank @>= rk@. |

726 | +-- Note that @forest@ is lazy, so if we discover a smaller key |

727 | +-- than @minKey@ later, we haven't wasted significant work. |

728 | +data Extract e rk = NoExtract | YesExtract e rk (BinomForest e rk) |

729 | + |

730 | +-- | Walks backward from the biggest key in the forest, as far as rank @rk@. |

731 | +-- Returns its progress. Each successive application of @extractBin@ takes |

732 | +-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time. |

733 | +extractBin :: (e -> e -> Bool) -> BinomForest e rk -> Extract e rk |

734 | +extractBin _ Nil = NoExtract |

735 | +extractBin (<=) (Skip f) = case extractBin (<=) f of |

736 | + NoExtract -> NoExtract |

737 | + YesExtract minKey (Succ kChild kChildren) f' -> |

738 | + YesExtract minKey kChildren (Cons kChild f') |

739 | +extractBin (<=) (Cons t@(BinomTree x ts) f) = case extractBin (<=) f of |

740 | + YesExtract minKey (Succ kChild kChildren) f' |

741 | + | minKey < x -> YesExtract minKey kChildren (Skip (carry1 (<=) (t `cat` kChild) f')) |

742 | + _ -> YesExtract x ts (Skip f) |

743 | + where cat = joinBin (<=) |

744 | + a < b = not (b <= a) |

745 | + |

746 | +filterQueue :: (a -> Bool) -> (a -> a -> Bool) -> (rk -> MinQueue a) -> MinQueue a -> BinomForest a rk -> MinQueue a |

747 | +filterQueue p (<=) fCh q0 forest = q0 `seq` case forest of |

748 | + Nil -> q0 |

749 | + Skip forest' -> filterQueue p (<=) fCh' q0 forest' |

750 | + Cons t forest' -> filterQueue p (<=) fCh' (union' (<=) (filterT p fCh t) q0) forest' |

751 | + where fCh' (Succ t tss) = union' (<=) (filterT p fCh t) (fCh tss) |

752 | + |

753 | +type Partition a = (MinQueue a, MinQueue a) |

754 | + |

755 | +partitionQueue :: (a -> Bool) -> (a -> a -> Bool) -> (rk -> Partition a) -> Partition a -> |

756 | + BinomForest a rk -> Partition a |

757 | +partitionQueue p (<=) fCh (q0, q1) forest = q0 `seq` q1 `seq` case forest of |

758 | + Nil -> (q0, q1) |

759 | + Skip forest' -> partitionQueue p (<=) fCh' (q0, q1) forest' |

760 | + Cons t forest' -> partitionQueue p (<=) fCh' (both (union' (<=)) (partitionT p fCh t) (q0, q1)) forest' |

761 | + where both f (x1, x2) (y1, y2) = (f x1 y1, f x2 y2) |

762 | + fCh' (Succ t tss) = both (union' (<=)) (partitionT p fCh t) (fCh tss) |

763 | + |

764 | +{-# INLINE filterT #-} |

765 | +filterT :: (a -> Bool) -> (rk -> MinQueue a) -> BinomTree a rk -> MinQueue a |

766 | +filterT p fCh (BinomTree x ts) |

767 | + | p x = insertMinQ x (fCh ts) |

768 | + | otherwise = fCh ts |

769 | + |

770 | +{-# INLINE partitionT #-} |

771 | +partitionT :: (a -> Bool) -> (rk -> Partition a) -> BinomTree a rk -> Partition a |

772 | +partitionT p fCh (BinomTree x ts) = case fCh ts of |

773 | + (q0, q1) |

774 | + | p x -> (insertMinQ x q0, q1) |

775 | + | otherwise -> (q0, insertMinQ x q1) |

776 | + |

777 | +{-# INLINE tip #-} |

778 | +-- | Constructs a binomial tree of rank 0. |

779 | +tip :: e -> BinomTree e () |

780 | +tip x = BinomTree x () |

781 | + |

782 | +-- | Given two binomial forests starting at rank @rk@, takes their union. |

783 | +-- Each successive application of this function costs /O(1)/, so applying it |

784 | +-- from the beginning costs /O(log n)/. |

785 | +merge :: (e -> e -> Bool) -> BinomForest e rk -> BinomForest e rk -> BinomForest e rk |

786 | +merge (<=) f1 f2 = case (f1, f2) of |

787 | + (Nil, _) -> f2 |

788 | + (_, Nil) -> f1 |

789 | + (Skip f1', Skip f2') |

790 | + -> Skip (merge (<=) f1' f2') |

791 | + (Skip f1', Cons t2 f2') |

792 | + -> Cons t2 (merge (<=) f1' f2') |

793 | + (Cons t1 f1', Skip f2') |

794 | + -> Cons t1 (merge (<=) f1' f2') |

795 | + (Cons t1 f1', Cons t2 f2') |

796 | + -> Skip (carry (<=) (t1 `cat` t2) f1' f2') |

797 | + where cat = joinBin (<=) |

798 | + |

799 | +-- | Merges two binomial forests with another tree. If we are thinking of the trees |

800 | +-- in the binomial forest as binary digits, this corresponds to a carry operation. |

801 | +-- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/. |

802 | +carry :: (e -> e -> Bool) -> BinomTree e rk -> BinomForest e rk -> BinomForest e rk -> BinomForest e rk |

803 | +carry (<=) t0 f1 f2 = t0 `seq` case (f1, f2) of |

804 | + (Nil, Nil) -> Cons t0 Nil |

805 | + (Nil, Skip f2') -> Cons t0 f2' |

806 | + (Skip f1', Nil) -> Cons t0 f1' |

807 | + (Nil, Cons t2 f2') -> Skip (carry1 (<=) (t0 `cat` t2) f2') |

808 | + (Cons t1 f1', Nil) -> Skip (carry1 (<=) (t0 `cat` t1) f1') |

809 | + (Skip f1', Skip f2') -> Cons t0 (merge (<=) f1' f2') |

810 | + (Skip f1', Cons t2 f2') -> Skip (carry (<=) (t0 `cat` t2) f1' f2') |

811 | + (Cons t1 f1', Skip f2') -> Skip (carry (<=) (t0 `cat` t1) f1' f2') |

812 | + (Cons t1 f1', Cons t2 f2') |

813 | + -> Cons t0 (carry (<=) (t1 `cat` t2) f1' f2') |

814 | + where cat = joinBin (<=) |

815 | + |

816 | +-- | Merges a binomial tree into a binomial forest. If we are thinking |

817 | +-- of the trees in the binomial forest as binary digits, this corresponds |

818 | +-- to adding a power of 2. This costs amortized /O(1)/ time. |

819 | +carry1 :: (e -> e -> Bool) -> BinomTree e rk -> BinomForest e rk -> BinomForest e rk |

820 | +carry1 (<=) t f = t `seq` case f of |

821 | + Nil -> Cons t Nil |

822 | + Skip f -> Cons t f |

823 | + Cons t' f' -> Skip (carry1 (<=) (t `cat` t') f') |

824 | + where cat = joinBin (<=) |

825 | + |

826 | +-- | The carrying operation: takes two binomial heaps of the same rank @k@ |

827 | +-- and returns one of rank @k+1@. Takes /O(1)/ time. |

828 | +joinBin :: (e -> e -> Bool) -> BinomTree e rk -> BinomTree e rk -> BinomTree' e rk |

829 | +joinBin (<=) t1@(BinomTree x1 ts1) t2@(BinomTree x2 ts2) |

830 | + | x1 <= x2 = BinomTree x1 (Succ t2 ts1) |

831 | + | otherwise = BinomTree x2 (Succ t1 ts2) |

832 | + |

833 | +instance Functor MinQueue where |

834 | + fmap _ Empty = Empty |

835 | + fmap f (MinQueue n x forest) = MinQueue n (f x) (mapForest f (const ()) forest) |

836 | + |

837 | +mapForest :: (a -> b) -> (rk -> rk') -> BinomForest a rk -> BinomForest b rk' |

838 | +mapForest f fCh forest = case forest of |

839 | + Nil -> Nil |

840 | + Skip forest' |

841 | + -> Skip (fF' forest') |

842 | + Cons t forest' |

843 | + -> Cons (fT t) (fF' forest') |

844 | + where fT (BinomTree x ts) = BinomTree (f x) (fCh ts) |

845 | + fCh' (Succ t ts) = Succ (fT t) (fCh ts) |

846 | + fF' = mapForest f fCh' |

847 | + |

848 | +instance Foldable MinQueue where |

849 | + foldr _ n Empty = n |

850 | + foldr c n (MinQueue _ x f) = x `c` foldrUnord c n (const id) f |

851 | + foldl _ n Empty = n |

852 | + foldl c n (MinQueue _ x f) = foldlUnord c (n `c` x) const f |

853 | + foldl1 c Empty = error "Error: foldl1 called on an empty queue" |

854 | + foldl1 c (MinQueue _ x f) = foldlUnord c x const f |

855 | + foldMap _ Empty = mempty |

856 | + foldMap f (MinQueue _ x forest) = f x `mappend` foldMap0 mappend mempty f forest |

857 | + |

858 | +-- | The initial level of 'foldMap'. Avoids unnecessary @'mappend' 'mempty'@ computations. |

859 | +foldMap0 :: (m -> m -> m) -> m -> (a -> m) -> BinomHeap a -> m |

860 | +foldMap0 (><) zero f forest = case forest of |

861 | + Nil -> zero |

862 | + Skip forest' |

863 | + -> fF' forest' |

864 | + Cons (BinomTree x _) forest' |

865 | + -> f x >< fF' forest' |

866 | + where fF' = foldMapUnord (><) zero f (\ (Succ (BinomTree x _) _) -> f x) |

867 | + |

868 | +-- | A recursive implementation of 'foldMap' capable of working up to trees of arbitrary rank. |

869 | +-- Does not respect ordering of the elements. |

870 | +foldMapUnord :: (m -> m -> m) -> m -> (a -> m) -> (rk -> m) -> BinomForest a rk -> m |

871 | +foldMapUnord (><) zero f fCh forest = case forest of |

872 | + Nil -> zero |

873 | + Skip forest' -> fF' forest' |

874 | + Cons t forest' -> fT t >< fF' forest' |

875 | + where fT (BinomTree x ts) = f x >< fCh ts |

876 | + fCh' (Succ t tss) = fT t >< fCh tss |

877 | + fF' = foldMapUnord (><) zero f fCh' |

878 | + |

879 | +-- | 'foldr' implementation on the binomial forest. Does not respect ordering of the elements. |

880 | +foldrUnord :: (a -> b -> b) -> b -> (rk -> b -> b) -> BinomForest a rk -> b |

881 | +foldrUnord c n cCh forest = case forest of |

882 | + Nil -> n |

883 | + Skip f' -> cF' f' |

884 | + Cons t f' -> t `cT` cF' f' |

885 | + where cT (BinomTree x ts) = c x . cCh ts |

886 | + cCh' (Succ t tss) = cT t . cCh tss |

887 | + cF' = foldrUnord c n cCh' |

888 | + |

889 | +foldlUnord :: (b -> a -> b) -> b -> (b -> rk -> b) -> BinomForest a rk -> b |

890 | +foldlUnord f z fCh forest = case forest of |

891 | + Nil -> z |

892 | + Skip forest' -> z `fF'` forest' |

893 | + Cons t forest' -> (z `fT` t) `fF'` forest' |

894 | + where fT z (BinomTree x ts) = (z `f` x) `fCh` ts |

895 | + fCh' z (Succ t tss) = (z `fT` t) `fCh` tss |

896 | + fF' z = foldlUnord f z fCh' |

897 | + |

898 | +instance Traversable MinQueue where |

899 | + traverse _ Empty = pure Empty |

900 | + traverse f (MinQueue n x forest) |

901 | + = MinQueue n <$> f x <*> traverseBin f (const (pure ())) forest |

902 | + |

903 | +traverseBin :: Applicative f => (a -> f b) -> (rk -> f rk') -> BinomForest a rk -> f (BinomForest b rk') |

904 | +traverseBin f fCh forest = case forest of |

905 | + Nil -> pure Nil |

906 | + Skip forest' |

907 | + -> Skip <$> fF' forest' |

908 | + Cons t forest' |

909 | + -> Cons <$> fT t <*> fF' forest' |

910 | + where fF' = traverseBin f fCh' |

911 | + fT (BinomTree x ts) = BinomTree <$> f x <*> fCh ts |

912 | + fCh' (Succ t tss) = Succ <$> fT t <*> fCh tss |

913 | + |

914 | +{-# INLINE toAscL #-} |

915 | +toAscL :: Ord a => BinomHeap a -> [a] |

916 | +toAscL h = build (\ c nil -> foldrOrd (<=) c nil h) |

917 | + |

918 | +-- | Right fold on a binomial forest. Respects order. |

919 | +foldrOrd :: (a -> a -> Bool) -> (a -> b -> b) -> b -> BinomHeap a -> b |

920 | +foldrOrd (<=) c n = foldQ0 where |

921 | + foldQ0 = foldQ1 . extractBin (<=) |

922 | + foldQ1 NoExtract = n |

923 | + foldQ1 (YesExtract x _ f) |

924 | + = x `c` foldQ0 f |

925 | + |

926 | +-- | Left fold on a binomial forest. Respects order. |

927 | +foldlOrd :: (a -> a -> Bool) -> (b -> a -> b) -> b -> BinomHeap a -> b |

928 | +foldlOrd (<=) f z = foldlQ0 z where |

929 | + foldlQ0 z = foldlQ1 z . extractBin (<=) |

930 | + foldlQ1 z NoExtract = z |

931 | + foldlQ1 z (YesExtract x _ f') |

932 | + = foldlQ0 (z `f` x) f' |

933 | + |

934 | +insertMinQ :: a -> MinQueue a -> MinQueue a |

935 | +insertMinQ x Empty = singleton x |

936 | +insertMinQ x (MinQueue n x' f) = MinQueue (n+1) x (insertMin (tip x') f) |

937 | + |

938 | +-- | @insertMin t f@ assumes that the root of @t@ compares as less than |

939 | +-- every other root in @f@, and merges accordingly. |

940 | +insertMin :: BinomTree e rk -> BinomForest e rk -> BinomForest e rk |

941 | +insertMin t Nil = Cons t Nil |

942 | +insertMin t (Skip f) = Cons t f |

943 | +insertMin (BinomTree x ts) (Cons t' f) = Skip (insertMin (BinomTree x (Succ t' ts)) f) |

944 | hunk ./containers.cabal 36 |

945 | Data.Graph |

946 | Data.Sequence |

947 | Data.Tree |

948 | + Data.PQueue.Min |

949 | + Data.PQueue.Max |

950 | + Data.PQueue |

951 | } |

952 | if impl(ghc) { |

953 | extensions: DeriveDataTypeable, MagicHash, Rank2Types |

954 | } |

955 | |

956 | Context: |

957 | |

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

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

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

961 | Malcolm.Wallace@cs.york.ac.uk**20091124025653 |

962 | There is some subtlety of polymorphically recursive datatypes and |

963 | type-class defaulting that nhc98's type system barfs over. |

964 | ] |

965 | [Fix another instance of non-ghc breakage. |

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

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

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

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

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

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

972 | Ross Paterson <ross@soi.city.ac.uk>**20091028105532 |

973 | Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9 |

974 | |

975 | As noted by iaefai on the libraries list. |

976 | |

977 | Please merge to STABLE. |

978 | ] |

979 | [Bump version to 0.3.0.0 |

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

981 | [update base dependency |

982 | Ross Paterson <ross@soi.city.ac.uk>**20090916073125 |

983 | Ignore-this: ad382ffc6c6a18c15364e6c072f19edb |

984 | |

985 | The package uses mkNoRepType and Data.Functor, which were not in the |

986 | stable branch of base-4. |

987 | ] |

988 | [add fast version of <$ for Seq |

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

990 | Ignore-this: 5a39a7d31d39760ed589790b1118d240 |

991 | ] |

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

993 | Ross Paterson <ross@soi.city.ac.uk>**20090915173324 |

994 | Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7 |

995 | |

996 | Adds a lot of new methods to Data.Sequence, mostly paralleling those |

997 | in Data.List. Several of these are significantly faster than versions |

998 | implemented with the previous public interface. In particular, replicate |

999 | takes O(log n) time and space instead of O(n). |

1000 | (by Louis Wasserman) |

1001 | ] |

1002 | [Fix "Cabal check" warnings |

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

1004 | [TAG 2009-06-25 |

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

1006 | Patch bundle hash: |

1007 | 2bdb114b6c6350a5c70a776cf40dc46fc164744d |