{-# LANGUAGE NamedFieldPuns, TypeSynonymInstances, FlexibleInstances, TypeFamilies, GeneralizedNewtypeDeriving #-} {-# OPTIONS -fno-warn-missing-methods -fno-warn-name-shadowing #-} {- | An efficient implementation of a priority queue. The implementation of 'PQueue' is based on a /pairing heap/, a simple and efficient implementation of a general-purpose priority queue. 'PQueue' supports 'insert', 'merge', and 'peek' in constant time, and 'extract' and 'delete' in logarithmic time. -} module Data.Queue.PQueue (PQueue) where import Data.Queue.Class import Data.Queue.QueueHelpers import Data.Maybe import Data.Monoid import Control.Monad -- Like with SkewQueue, the real meat of the pairing heap is very succinctly presented: it's all in the Monoid instance, and in the extract method, where the fusing method from QueueHelpers (already used for QueueHelpers' generic merging implementation) provides all the magic. Everything else is deliciously succinct boilerplate, largely derived from HeapQ's Monoid instance. data Tree e = T e [Tree e] newtype PQueue e = PQ (HeapQ (Tree e)) deriving (Monoid, Queuelike) instance Ord e => Monoid (Tree e) where -- no actual mzero instance, but induces a correct Monoid instance for Heap e t1@(T x1 ts1) `mappend` t2@(T x2 ts2) | x1 <= x2 = T x1 (t2:ts1) | otherwise = T x2 (t1:ts2) instance Ord e => Queuelike (HeapQ (Tree e)) where {-# INLINE fromList #-} {-# INLINE toList_ #-} {-# INLINE mergeAll #-} {-# INLINE insertAll #-} type QueueKey (HeapQ (Tree e)) = e empty = mempty singleton = single fromList ts = mconcat (map single ts) x `insert` q = q `mappend` single x xs `insertAll` q = q `mappend` fromList xs merge = mappend mergeAll = mconcat extract (HQ n t) = fmap (\ (T x ts) -> (x, HQ (n-1) (fusing ts))) t toList_ = maybe [] flatten . heap size = elts single :: e -> HeapQ (Tree e) single x = HQ 1 $ Just (T x []) flatten :: Tree e -> [e] flatten (T x ts) = [x] ++ concatMap flatten ts