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

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

Line | |
---|---|

1 | Tue Mar 16 13:05:08 CDT 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**20100316180508 |

8 | Ignore-this: 801ce6ed62a9312eb668abf70f9270fa |

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 | + -- * Utility types |

41 | + Min.Prio(..), |

42 | + -- * Basic operations |

43 | + empty, |

44 | + null, |

45 | + size, |

46 | + -- * Query operations |

47 | + top, |

48 | + delete, |

49 | + extract, |

50 | + -- * Construction operations |

51 | + singleton, |

52 | + insert, |

53 | + union, |

54 | + unions, |

55 | + -- * Extracting elements |

56 | + (!!), |

57 | + take, |

58 | + drop, |

59 | + splitAt, |

60 | + takeWhile, |

61 | + dropWhile, |

62 | + span, |

63 | + break, |

64 | + filter, |

65 | + partition, |

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

67 | + mapMonotonic, |

68 | + foldrAsc, |

69 | + foldlAsc, |

70 | + foldrDesc, |

71 | + foldlDesc, |

72 | + traverseMonotonic, |

73 | + -- * List operations |

74 | + toList, |

75 | + toAscList, |

76 | + toDescList, |

77 | + fromList, |

78 | + fromAscList, |

79 | + fromDescList) where |

80 | + |

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

82 | + |

83 | +import Data.Monoid |

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

85 | +import Data.Traversable |

86 | +import Data.Ord |

87 | + |

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

89 | + |

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

91 | + |

92 | +#ifdef __GLASGOW_HASKELL__ |

93 | +import GHC.Exts (build) |

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

95 | + readPrec, readListPrec, readListPrecDefault) |

96 | +import Data.Data |

97 | +#else |

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

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

100 | +#endif |

101 | + |

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

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

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

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

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

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

108 | +-- |

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

110 | +-- 'foldlDesc'. |

111 | +newtype MaxQueue a = MaxQ (Min.MinQueue (Down a)) |

112 | +# if __GLASGOW_HASKELL__ |

113 | + deriving (Eq, Ord, Data, Typeable) |

114 | +# else |

115 | + deriving (Eq, Ord) |

116 | +# endif |

117 | + |

118 | +newtype Down a = Down {unDown :: a} |

119 | +# if __GLASGOW_HASKELL__ |

120 | + deriving (Eq, Data, Typeable) |

121 | +# else |

122 | + deriving (Eq) |

123 | +# endif |

124 | + |

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

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

127 | + Down x <= Down y = y <= x |

128 | + |

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

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

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

132 | + |

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

134 | +#ifdef __GLASGOW_HASKELL__ |

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

136 | + Ident "fromDescList" <- lexP |

137 | + xs <- readPrec |

138 | + return (fromDescList xs) |

139 | + |

140 | + readListPrec = readListPrecDefault |

141 | +#else |

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

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

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

145 | + return (fromDescList xs,t) |

146 | +#endif |

147 | + |

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

149 | + mempty = empty |

150 | + mappend = union |

151 | + |

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

153 | +empty :: MaxQueue a |

154 | +empty = MaxQ Min.empty |

155 | + |

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

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

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

159 | + |

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

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

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

163 | + |

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

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

166 | +top = fmap fst . extract |

167 | + |

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

169 | +extract :: Ord a => MaxQueue a -> Maybe (a, MaxQueue a) |

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

171 | + Nothing -> Nothing |

172 | + Just (Down x, q') |

173 | + -> Just (x, MaxQ q') |

174 | + |

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

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

177 | +delete = fmap snd . extract |

178 | + |

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

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

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

182 | + |

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

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

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

186 | + |

187 | +-- | /O(log (min(n1,n2)))/. Take the union of two priority queues. |

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

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

190 | + |

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

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

193 | +unions qs = MaxQ (Min.unions [q | MaxQ q <- qs]) |

194 | + |

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

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

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

198 | + |

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

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

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

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

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

204 | + |

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

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

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

208 | + |

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

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

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

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

213 | + |

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

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

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

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

218 | + |

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

220 | +-- |

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

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

223 | + |

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

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

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

227 | +-- |

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

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

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

231 | + |

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

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

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

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

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

237 | + |

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

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

240 | + |

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

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

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

244 | + |

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

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

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

248 | +mapMonotonic = fmap |

249 | + |

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

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

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

253 | +traverseMonotonic = traverse |

254 | + |

255 | +instance Functor Down where |

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

257 | + |

258 | +instance Foldable Down where |

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

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

261 | + |

262 | +instance Traversable Down where |

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

264 | + |

265 | +instance Functor MaxQueue where |

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

267 | + |

268 | +instance Foldable MaxQueue where |

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

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

271 | + |

272 | +instance Traversable MaxQueue where |

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

274 | + |

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

276 | +-- @'foldrAsc' f z q == 'foldlDesc' (flip f) z q@. |

277 | +foldrAsc :: Ord a => (a -> b -> b) -> b -> MaxQueue a -> b |

278 | +foldrAsc = foldlDesc . flip |

279 | + |

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

281 | +-- @'foldlAsc' f z q == 'foldrDesc' (flip f) z q@. |

282 | +foldlAsc :: Ord a => (b -> a -> b) -> b -> MaxQueue a -> b |

283 | +foldlAsc = foldrDesc . flip |

284 | + |

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

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

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

288 | + |

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

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

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

292 | + |

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

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

295 | +toAscList :: Ord a => MaxQueue a -> [a] |

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

297 | + |

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

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

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

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

302 | + |

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

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

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

306 | +#ifdef __GLASGOW_HASKELL__ |

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

308 | +#else |

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

310 | +#endif |

311 | + |

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

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

314 | +fromAscList :: [a] -> MaxQueue a |

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

316 | + |

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

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

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

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

321 | + |

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

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

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

325 | +fromList = foldr insert empty |

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

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

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

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

330 | +----------------------------------------------------------------------------- |

331 | +-- | |

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

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

334 | +-- License : BSD-style |

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

336 | +-- Stability : experimental |

337 | +-- Portability : portable |

338 | +-- |

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

340 | +-- |

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

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

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

344 | +-- |

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

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

347 | +-- as they are performed. |

348 | +-- |

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

350 | +-- "Data.Map". |

351 | +----------------------------------------------------------------------------- |

352 | +module Data.PQueue.Min ( |

353 | + MinQueue, |

354 | + -- * Utility types |

355 | + Prio(..), |

356 | + -- * Basic operations |

357 | + empty, |

358 | + null, |

359 | + size, |

360 | + -- * Query operations |

361 | + top, |

362 | + delete, |

363 | + extract, |

364 | + -- * Construction operations |

365 | + singleton, |

366 | + insert, |

367 | + union, |

368 | + unions, |

369 | + -- * Subsets |

370 | + -- ** Extracting subsets |

371 | + (!!), |

372 | + take, |

373 | + drop, |

374 | + splitAt, |

375 | + -- ** Predicates |

376 | + takeWhile, |

377 | + dropWhile, |

378 | + span, |

379 | + break, |

380 | + filter, |

381 | + partition, |

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

383 | + mapMonotonic, |

384 | + foldrAsc, |

385 | + foldlAsc, |

386 | + foldrDesc, |

387 | + foldlDesc, |

388 | + traverseMonotonic, |

389 | + -- * List operations |

390 | + toList, |

391 | + toAscList, |

392 | + toDescList, |

393 | + fromList, |

394 | + fromAscList, |

395 | + fromDescList) where |

396 | + |

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

398 | + |

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

400 | + |

401 | +import Data.Monoid |

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

403 | +import Data.Traversable |

404 | + |

405 | +import qualified Data.List as List |

406 | + |

407 | +#ifdef __GLASGOW_HASKELL__ |

408 | +import GHC.Exts (build) |

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

410 | + readPrec, readListPrec, readListPrecDefault) |

411 | +import Data.Data |

412 | +#else |

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

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

415 | +#endif |

416 | + |

417 | +-- | Type which orders only based on its priority value. Useful for putting in a priority queue |

418 | +-- which is meant to account for both an ordering value and other information. |

419 | +data Prio p a = Prio {priority :: p, prioValue :: a} |

420 | +# if __GLASGOW_HASKELL__ |

421 | + deriving (Read, Show, Data, Typeable) |

422 | +# else |

423 | + deriving (Read, Show) |

424 | +# endif |

425 | + |

426 | +instance Eq p => Eq (Prio p a) where |

427 | + Prio p1 _ == Prio p2 _ = p1 == p2 |

428 | + |

429 | +instance Ord p => Ord (Prio p a) where |

430 | + Prio p1 _ `compare` Prio p2 _ = p1 `compare` p2 |

431 | + Prio p1 _ <= Prio p2 _ = p1 <= p2 |

432 | + |

433 | +-- instance |

434 | + |

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

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

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

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

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

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

441 | +-- |

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

443 | +-- 'foldlAsc'. |

444 | +-- |

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

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

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

448 | + |

449 | +#ifdef __GLASGOW_HASKELL__ |

450 | +instance (Ord a, Data a) => Data (MinQueue a) where |

451 | + gfoldl f z q = case extract q of |

452 | + Nothing -> z Empty |

453 | + Just (x, q') |

454 | + -> z insertMinQ `f` x `f` q' |

455 | + |

456 | + gunfold k z c = case constrIndex c of |

457 | + 1 -> z Empty |

458 | + 2 -> k (k (z insertMinQ)) |

459 | + _ -> error "gunfold" |

460 | + |

461 | + toConstr q |

462 | + | null q = emptyConstr |

463 | + | otherwise = consConstr |

464 | + |

465 | + dataTypeOf _ = queueDataType |

466 | + |

467 | +queueDataType :: DataType |

468 | +queueDataType = mkDataType "Data.PQueue.Min.MinQueue" [emptyConstr, consConstr] |

469 | + |

470 | +emptyConstr, consConstr :: Constr |

471 | +emptyConstr = mkConstr queueDataType "empty" [] Prefix |

472 | +consConstr = mkConstr queueDataType "<|" [] Infix |

473 | +#endif |

474 | + |

475 | +#include "Typeable.h" |

476 | +INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue") |

477 | + |

478 | +type BinomHeap = BinomForest Zero |

479 | + |

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

481 | + Empty == Empty = True |

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

483 | + = n1 == n2 && x1 == x2 && foldr (&&) True |

484 | + (zipWith (==) (heapToList q1) (heapToList q2)) |

485 | + _ == _ = False |

486 | + |

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

488 | + Empty `compare` Empty = EQ |

489 | + Empty `compare` _ = LT |

490 | + _ `compare` Empty = GT |

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

492 | + compare x1 x2 `mappend` foldr mappend (compare n1 n2) (zipWith compare (heapToList q1) (heapToList q2)) |

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

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

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

496 | + |

497 | +heapToList :: Ord a => BinomHeap a -> [a] |

498 | +heapToList q = build (\ c nil -> foldrUnfold c nil extractHeap q) |

499 | + |

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

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

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

503 | + |

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

505 | +#ifdef __GLASGOW_HASKELL__ |

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

507 | + Ident "fromAscList" <- lexP |

508 | + xs <- readPrec |

509 | + return (fromAscList xs) |

510 | + |

511 | + readListPrec = readListPrecDefault |

512 | +#else |

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

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

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

516 | + return (fromAscList xs,t) |

517 | +#endif |

518 | + |

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

520 | + mempty = Empty |

521 | + mappend = union |

522 | + mconcat = unions |

523 | + |

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

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

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

527 | +-- |

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

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

530 | +-- as follows: |

531 | +-- |

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

533 | +-- |

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

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

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

537 | +-- |

538 | +-- > data Succ rk a = Succ (BinomTree rk a) (rk a) |

539 | +-- |

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

541 | +-- we immediately obtain that |

542 | +-- |

543 | +-- > data BinomTree rk a = BinomTree a (rk a) |

544 | +-- |

545 | +-- which is nice and compact. With this construction, things work out extremely nicely: |

546 | +-- |

547 | +-- > BinomTree (Succ (Succ (Succ Zero))) |

548 | +-- |

549 | +-- is a type constructor that takes an element type and returns the type of binomial trees |

550 | +-- of rank @3@. |

551 | +data BinomForest rk a = Nil | Skip !(BinomForest (Succ rk) a) | |

552 | + Cons {-# UNPACK #-} !(BinomTree rk a) !(BinomForest (Succ rk) a) |

553 | + |

554 | +data BinomTree rk a = BinomTree a (rk a) |

555 | + |

556 | +-- | If |rk| corresponds to rank @k@, then |'Succ' rk| corresponds to rank @k+1@. |

557 | +data Succ rk a = Succ {-# UNPACK #-} !(BinomTree rk a) (rk a) |

558 | + |

559 | +-- | Type corresponding to the zero rank. |

560 | +data Zero a = Zero |

561 | + |

562 | +-- | Type alias for a comparison function. |

563 | +type LEq a = a -> a -> Bool |

564 | + |

565 | +-- basics |

566 | + |

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

568 | +empty :: MinQueue a |

569 | +empty = Empty |

570 | + |

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

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

573 | +null Empty = True |

574 | +null _ = False |

575 | + |

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

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

578 | +size Empty = 0 |

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

580 | + |

581 | +-- queries |

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

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

584 | +top = fmap fst . extract |

585 | + |

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

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

588 | +delete = fmap snd . extract |

589 | + |

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

591 | +extract :: Ord a => MinQueue a -> Maybe (a, MinQueue a) |

592 | +extract Empty = Nothing |

593 | +extract (MinQueue n x ts) = Just (x, maybe Empty (\ (x', ts') -> MinQueue (n-1) x' ts') (extractHeap ts)) |

594 | + |

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

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

597 | +singleton x = MinQueue 1 x Nil |

598 | + |

599 | +-- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element into the priority queue. |

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

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

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

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

604 | + where insertBin = incr (<=) . tip |

605 | +insert x Empty = singleton x |

606 | + |

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

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

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

610 | + |

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

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

613 | +unions = foldl union Empty |

614 | + |

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

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

617 | +q !! n | n >= size q |

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

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

620 | + |

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

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

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

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

625 | +takeWhile p = foldWhileFB p . toAscList |

626 | + |

627 | +{-# INLINE foldWhileFB #-} |

628 | +-- | Equivalent to Data.List.takeWhile, but is a better producer. |

629 | +foldWhileFB :: (a -> Bool) -> [a] -> [a] |

630 | +foldWhileFB p xs = build (\ c nil -> let |

631 | + consWhile x xs |

632 | + | p x = x `c` xs |

633 | + | otherwise = nil |

634 | + in foldr consWhile nil xs) |

635 | + |

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

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

638 | +dropWhile p = drop' where |

639 | + drop' q = case extract q of |

640 | + Just (x, q') |

641 | + | p x -> drop' q' |

642 | + _ -> q |

643 | + |

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

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

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

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

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

649 | + Just (x, q') |

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

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

652 | + |

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

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

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

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

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

658 | + |

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

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

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

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

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

664 | + |

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

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

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

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

669 | + Just queue' |

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

671 | + _ -> queue |

672 | + |

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

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

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

676 | + Just (x, queue') |

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

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

679 | + |

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

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

682 | +filter _ Empty = Empty |

683 | +filter p (MinQueue _ x ts) = if p x then insertMinQ x q' else q' |

684 | + where q' = filterQueue p (<=) (const Empty) Empty ts |

685 | + |

686 | +-- | /O(n)/. Returns a pair where the first queue contains all elements satisfying @p@, and the second queue |

687 | +-- contains all elements not satisfying @p@. |

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

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

690 | +partition p (MinQueue _ x ts) = case partitionQueue p (<=) (const (Empty, Empty)) (Empty, Empty) ts of |

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

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

693 | + |

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

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

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

697 | +mapMonotonic _ Empty = Empty |

698 | +mapMonotonic f (MinQueue n x ts) = MinQueue n (f x) (fmap f ts) |

699 | + |

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

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

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

703 | +traverseMonotonic _ Empty = pure Empty |

704 | +traverseMonotonic f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse f ts |

705 | + |

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

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

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

709 | +toAscList queue = build (\ c nil -> foldrAsc c nil queue) |

710 | + |

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

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

713 | +toDescList :: Ord a => MinQueue a -> [a] |

714 | +toDescList queue = build (\ c nil -> foldrDesc c nil queue) |

715 | + |

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

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

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

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

720 | + |

721 | +{-# INLINE foldrAsc #-} |

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

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

724 | +foldrAsc _ z Empty = z |

725 | +foldrAsc f z (MinQueue _ x ts) = x `f` foldrUnfold f z extractHeap ts |

726 | + |

727 | +{-# INLINE foldrUnfold #-} |

728 | +-- | Equivalent to @foldr f z (unfoldr suc s0)@. |

729 | +foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c |

730 | +foldrUnfold f z suc s0 = unf s0 where |

731 | + unf s = case suc s of |

732 | + Nothing -> z |

733 | + Just (x, s') -> x `f` unf s' |

734 | + |

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

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

737 | +foldlAsc _ z Empty = z |

738 | +foldlAsc f z (MinQueue _ x ts) = foldlUnfold f (z `f` x) extractHeap ts |

739 | + |

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

741 | +-- @foldrDesc f z q == foldlAsc (flip f) z q@. |

742 | +foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b |

743 | +foldrDesc = foldlAsc . flip |

744 | + |

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

746 | +-- @foldlDesc f z q == foldrAsc (flip f) z q@. |

747 | +foldlDesc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b |

748 | +foldlDesc = foldrAsc . flip |

749 | + |

750 | +{-# INLINE foldlUnfold #-} |

751 | +-- | @foldlUnfold f z suc s0@ is equivalent to @foldl f z (unfoldr suc s0)@. |

752 | +foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c |

753 | +foldlUnfold f z suc s0 = unf z s0 where |

754 | + unf z s = case suc s of |

755 | + Nothing -> z |

756 | + Just (x, s') -> unf (z `f` x) s' |

757 | + |

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

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

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

761 | +fromList = foldr insert Empty |

762 | + |

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

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

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

766 | +fromAscList = foldr insertMinQ Empty |

767 | + |

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

769 | +fromDescList :: [a] -> MinQueue a |

770 | +fromDescList [] = Empty |

771 | +fromDescList (x:xs) = descList 1 x Nil xs where |

772 | + descList n x ts xs = n `seq` case xs of |

773 | + [] -> MinQueue n x ts |

774 | + x':xs' -> descList (n+1) x' (tip x `insertMin` ts) xs' |

775 | + |

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

777 | +union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a |

778 | +union' _ Empty q = q |

779 | +union' _ q Empty = q |

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

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

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

783 | + |

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

785 | +extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a) |

786 | +extractHeap ts = case extractBin (<=) ts of |

787 | + Yes (Extract x _ ts') -> Just (x, ts') |

788 | + _ -> Nothing |

789 | + |

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

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

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

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

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

795 | +-- |

796 | +-- The interpretation of @Extract minKey children forest@ is |

797 | +-- |

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

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

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

801 | +-- |

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

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

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

805 | +-- |

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

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

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

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

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

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

812 | +data Extract rk a = Extract a (rk a) (BinomForest rk a) |

813 | +data MExtract rk a = No | Yes {-# UNPACK #-} !(Extract rk a) |

814 | + |

815 | +incrExtract :: Extract (Succ rk) a -> Extract rk a |

816 | +incrExtract (Extract minKey (Succ kChild kChildren) ts) |

817 | + = Extract minKey kChildren (Cons kChild ts) |

818 | + |

819 | +incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a |

820 | +incrExtract' (<=) t (Extract minKey (Succ kChild kChildren) ts) |

821 | + = Extract minKey kChildren (Skip (incr (<=) (t `cat` kChild) ts)) |

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

823 | + |

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

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

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

827 | +extractBin :: LEq a -> BinomForest rk a -> MExtract rk a |

828 | +extractBin _ Nil = No |

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

830 | + Yes ex -> Yes (incrExtract ex) |

831 | + No -> No |

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

833 | + Yes ex@(Extract minKey _ _) |

834 | + | minKey < x -> incrExtract' (<=) t ex |

835 | + _ -> Extract x ts (Skip f) |

836 | + where a < b = not (b <= a) |

837 | + |

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

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

840 | + Nil -> q0 |

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

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

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

844 | + filterT (BinomTree x ts) |

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

846 | + | otherwise = fCh ts |

847 | + |

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

849 | + |

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

851 | + BinomForest rk a -> Partition a |

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

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

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

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

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

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

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

859 | + (q0, q1) |

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

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

862 | + |

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

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

865 | +tip :: a -> BinomTree Zero a |

866 | +tip x = BinomTree x Zero |

867 | + |

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

869 | +insertMinQ x Empty = singleton x |

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

871 | + |

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

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

874 | +insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a |

875 | +insertMin t Nil = Cons t Nil |

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

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

878 | + |

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

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

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

882 | +merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a |

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

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

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

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

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

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

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

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

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

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

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

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

895 | + |

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

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

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

899 | +carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a |

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

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

902 | + (Skip f1', Cons t2 f2') -> Skip (mergeCarry t0 t2 f1' f2') |

903 | + (Cons t1 f1', Skip f2') -> Skip (mergeCarry t0 t1 f1' f2') |

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

905 | + -> Cons t0 (mergeCarry t1 t2 f1' f2') |

906 | + (Nil, _f2) -> incr (<=) t0 f2 |

907 | + (_f1, Nil) -> incr (<=) t0 f1 |

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

909 | + mergeCarry tA tB = carry (<=) (tA `cat` tB) |

910 | + |

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

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

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

914 | +incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a |

915 | +incr (<=) t f = t `seq` case f of |

916 | + Nil -> Cons t Nil |

917 | + Skip f -> Cons t f |

918 | + Cons t' f' -> Skip (incr (<=) (t `cat` t') f') |

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

920 | + |

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

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

923 | +joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a |

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

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

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

927 | + |

928 | +instance Functor Zero where |

929 | + fmap _ _ = Zero |

930 | + |

931 | +instance Functor rk => Functor (Succ rk) where |

932 | + fmap f (Succ t ts) = Succ (fmap f t) (fmap f ts) |

933 | + |

934 | +instance Functor rk => Functor (BinomTree rk) where |

935 | + fmap f (BinomTree x ts) = BinomTree (f x) (fmap f ts) |

936 | + |

937 | +instance Functor rk => Functor (BinomForest rk) where |

938 | + fmap _ Nil = Nil |

939 | + fmap f (Skip ts) = Skip (fmap f ts) |

940 | + fmap f (Cons t ts) = Cons (fmap f t) (fmap f ts) |

941 | + |

942 | +instance Foldable Zero where |

943 | + foldr _ z _ = z |

944 | + foldl _ z _ = z |

945 | + |

946 | +instance Foldable rk => Foldable (Succ rk) where |

947 | + foldr f z (Succ t ts) = foldr f (foldr f z ts) t |

948 | + foldl f z (Succ t ts) = foldl f (foldl f z t) ts |

949 | + |

950 | +instance Foldable rk => Foldable (BinomTree rk) where |

951 | + foldr f z (BinomTree x ts) = x `f` foldr f z ts |

952 | + foldl f z (BinomTree x ts) = foldl f (z `f` x) ts |

953 | + |

954 | +instance Foldable rk => Foldable (BinomForest rk) where |

955 | + foldr _ z Nil = z |

956 | + foldr f z (Skip ts) = foldr f z ts |

957 | + foldr f z (Cons t ts) = foldr f (foldr f z ts) t |

958 | + foldl _ z Nil = z |

959 | + foldl f z (Skip ts) = foldl f z ts |

960 | + foldl f z (Cons t ts) = foldl f (foldl f z t) ts |

961 | + |

962 | +instance Foldable MinQueue where |

963 | + foldr _ z Empty = z |

964 | + foldr f z (MinQueue _ x ts) = x `f` foldr f z ts |

965 | + foldl _ z Empty = z |

966 | + foldl f z (MinQueue _ x ts) = foldl f (z `f` x) ts |

967 | + foldl1 _ Empty = error "Error: foldl1 called on empty queue" |

968 | + foldl1 f (MinQueue _ x ts) = foldl f x ts |

969 | + |

970 | +instance Traversable Zero where |

971 | + traverse _ _ = pure Zero |

972 | + |

973 | +instance Traversable rk => Traversable (Succ rk) where |

974 | + traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts |

975 | + |

976 | +instance Traversable rk => Traversable (BinomTree rk) where |

977 | + traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts |

978 | + |

979 | +instance Traversable rk => Traversable (BinomForest rk) where |

980 | + traverse _ Nil = pure Nil |

981 | + traverse f (Skip ts) = Skip <$> traverse f ts |

982 | + traverse f (Cons t ts) = Cons <$> traverse f t <*> traverse f ts |

983 | hunk ./containers.cabal 36 |

984 | Data.Graph |

985 | Data.Sequence |

986 | Data.Tree |

987 | + Data.PQueue.Min |

988 | + Data.PQueue.Max |

989 | + Data.PQueue |

990 | } |

991 | if impl(ghc) { |

992 | extensions: DeriveDataTypeable, MagicHash, Rank2Types |

993 | } |

994 | |

995 | Context: |

996 | |

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

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

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

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

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

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

1003 | ] |

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

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

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

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

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

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

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

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

1012 | Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9 |

1013 | |

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

1015 | |

1016 | Please merge to STABLE. |

1017 | ] |

1018 | [Bump version to 0.3.0.0 |

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

1020 | [update base dependency |

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

1022 | Ignore-this: ad382ffc6c6a18c15364e6c072f19edb |

1023 | |

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

1025 | stable branch of base-4. |

1026 | ] |

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

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

1029 | Ignore-this: 5a39a7d31d39760ed589790b1118d240 |

1030 | ] |

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

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

1033 | Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7 |

1034 | |

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

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

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

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

1039 | (by Louis Wasserman) |

1040 | ] |

1041 | [Fix "Cabal check" warnings |

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

1043 | [TAG 2009-06-25 |

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

1045 | Patch bundle hash: |

1046 | 86b8fdb31be31315e4671c250c5e5c9b8cd1e7bd |