diff --git a/Data/FingerTree.hs b/Data/FingerTree.hs --- a/Data/FingerTree.hs +++ b/Data/FingerTree.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-} - ----------------------------------------------------------------------------- -- | -- Module : Data.FingerTree @@ -44,7 +42,8 @@ split, takeUntil, dropUntil, -- * Transformation reverse, - fmap', traverse' + fmap', fmapWithPos, unsafeFmap, + traverse', traverseWithPos, unsafeTraverse ) where import Prelude hiding (null, reverse) @@ -72,13 +71,17 @@ deriving (Eq, Ord, Show, Read) instance Functor s => Functor (ViewL s) where - fmap f EmptyL = EmptyL + fmap f EmptyL = EmptyL fmap f (x :< xs) = f x :< fmap f xs instance Functor s => Functor (ViewR s) where - fmap f EmptyR = EmptyR + fmap f EmptyR = EmptyR fmap f (xs :> x) = fmap f xs :> f x +instance Measured v a => Monoid (FingerTree v a) where + mempty = empty + mappend = (><) + -- Explicit Digit type (Exercise 1) data Digit a @@ -185,6 +188,54 @@ mapDigit f (Three a b c) = Three (f a) (f b) (f c) mapDigit f (Four a b c d) = Four (f a) (f b) (f c) (f d) +-- | Map all elements of the tree with a function that also takes the +-- measure of the prefix of the tree to the left of the element. +fmapWithPos :: (Measured v1 a1, Measured v2 a2) => + (v1 -> a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2 +fmapWithPos f = mapWPTree f mempty + +mapWPTree :: (Measured v1 a1, Measured v2 a2) => + (v1 -> a1 -> a2) -> v1 -> FingerTree v1 a1 -> FingerTree v2 a2 +mapWPTree _ _ Empty = Empty +mapWPTree f v (Single x) = Single (f v x) +mapWPTree f v (Deep _ pr m sf) = + deep (mapWPDigit f v pr) + (mapWPTree (mapWPNode f) vpr m) + (mapWPDigit f vm sf) + where vpr = v `mappend` measure pr + vm = vpr `mappendVal` m + +mapWPNode :: (Measured v1 a1, Measured v2 a2) => + (v1 -> a1 -> a2) -> v1 -> Node v1 a1 -> Node v2 a2 +mapWPNode f v (Node2 _ a b) = node2 (f v a) (f va b) + where va = v `mappend` measure a +mapWPNode f v (Node3 _ a b c) = node3 (f v a) (f va b) (f vab c) + where va = v `mappend` measure a + vab = va `mappend` measure b + +mapWPDigit :: (Measured v a) => (v -> a -> b) -> v -> Digit a -> Digit b +mapWPDigit f v (One a) = One (f v a) +mapWPDigit f v (Two a b) = Two (f v a) (f va b) + where va = v `mappend` measure a +mapWPDigit f v (Three a b c) = Three (f v a) (f va b) (f vab c) + where va = v `mappend` measure a + vab = va `mappend` measure b +mapWPDigit f v (Four a b c d) = Four (f v a) (f va b) (f vab c) (f vabc d) + where va = v `mappend` measure a + vab = va `mappend` measure b + vabc = vab `mappend` measure c + +-- | Like 'fmap', but safe only if the function preserves the measure. +unsafeFmap :: (a -> b) -> FingerTree v a -> FingerTree v b +unsafeFmap _ Empty = Empty +unsafeFmap f (Single x) = Single (f x) +unsafeFmap f (Deep v pr m sf) = + Deep v (mapDigit f pr) (unsafeFmap (unsafeFmapNode f) m) (mapDigit f sf) + +unsafeFmapNode :: (a -> b) -> Node v a -> Node v b +unsafeFmapNode f (Node2 v a b) = Node2 v (f a) (f b) +unsafeFmapNode f (Node3 v a b c) = Node3 v (f a) (f b) (f c) + -- | Like 'traverse', but with a more constrained type. traverse' :: (Measured v1 a1, Measured v2 a2, Applicative f) => (a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2) @@ -208,6 +259,55 @@ traverseDigit f (Three a b c) = Three <$> f a <*> f b <*> f c traverseDigit f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d +-- | Traverse the tree with a function that also takes the +-- measure of the prefix of the tree to the left of the element. +traverseWithPos :: (Measured v1 a1, Measured v2 a2, Applicative f) => + (v1 -> a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2) +traverseWithPos f = traverseWPTree f mempty + +traverseWPTree :: (Measured v1 a1, Measured v2 a2, Applicative f) => + (v1 -> a1 -> f a2) -> v1 -> FingerTree v1 a1 -> f (FingerTree v2 a2) +traverseWPTree _ _ Empty = pure Empty +traverseWPTree f v (Single x) = Single <$> f v x +traverseWPTree f v (Deep _ pr m sf) = + deep <$> traverseWPDigit f v pr <*> traverseWPTree (traverseWPNode f) vpr m <*> traverseWPDigit f vm sf + where vpr = v `mappend` measure pr + vm = vpr `mappendVal` m + +traverseWPNode :: (Measured v1 a1, Measured v2 a2, Applicative f) => + (v1 -> a1 -> f a2) -> v1 -> Node v1 a1 -> f (Node v2 a2) +traverseWPNode f v (Node2 _ a b) = node2 <$> f v a <*> f va b + where va = v `mappend` measure a +traverseWPNode f v (Node3 _ a b c) = node3 <$> f v a <*> f va b <*> f vab c + where va = v `mappend` measure a + vab = va `mappend` measure b + +traverseWPDigit :: (Measured v a, Applicative f) => + (v -> a -> f b) -> v -> Digit a -> f (Digit b) +traverseWPDigit f v (One a) = One <$> f v a +traverseWPDigit f v (Two a b) = Two <$> f v a <*> f va b + where va = v `mappend` measure a +traverseWPDigit f v (Three a b c) = Three <$> f v a <*> f va b <*> f vab c + where va = v `mappend` measure a + vab = va `mappend` measure b +traverseWPDigit f v (Four a b c d) = Four <$> f v a <*> f va b <*> f vab c <*> f vabc d + where va = v `mappend` measure a + vab = va `mappend` measure b + vabc = vab `mappend` measure c + +-- | Like 'traverse', but safe only if the function preserves the measure. +unsafeTraverse :: (Applicative f) => + (a -> f b) -> FingerTree v a -> f (FingerTree v b) +unsafeTraverse _ Empty = pure Empty +unsafeTraverse f (Single x) = Single <$> f x +unsafeTraverse f (Deep v pr m sf) = + Deep v <$> traverseDigit f pr <*> unsafeTraverse (unsafeTraverseNode f) m <*> traverseDigit f sf + +unsafeTraverseNode :: (Applicative f) => + (a -> f b) -> Node v a -> f (Node v b) +unsafeTraverseNode f (Node2 v a b) = Node2 v <$> f a <*> f b +unsafeTraverseNode f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c + ----------------------------------------------------- -- 4.3 Construction, deconstruction and concatenation ----------------------------------------------------- @@ -229,9 +329,10 @@ (<|) :: (Measured v a) => a -> FingerTree v a -> FingerTree v a a <| Empty = Single a a <| Single b = deep (One a) Empty (One b) -a <| Deep _ (Four b c d e) m sf = m `seq` - deep (Two a b) (node3 c d e <| m) sf -a <| Deep _ pr m sf = deep (consDigit a pr) m sf +a <| Deep v (Four b c d e) m sf = m `seq` + Deep (measure a `mappend` v) (Two a b) (node3 c d e <| m) sf +a <| Deep v pr m sf = + Deep (measure a `mappend` v) (consDigit a pr) m sf consDigit :: a -> Digit a -> Digit a consDigit a (One b) = Two a b @@ -243,9 +344,10 @@ (|>) :: (Measured v a) => FingerTree v a -> a -> FingerTree v a Empty |> a = Single a Single a |> b = deep (One a) Empty (One b) -Deep _ pr m (Four a b c d) |> e = m `seq` - deep pr (m |> node3 a b c) (Two d e) -Deep _ pr m sf |> x = deep pr m (snocDigit sf x) +Deep v pr m (Four a b c d) |> e = m `seq` + Deep (v `mappend` measure e) pr (m |> node3 a b c) (Two d e) +Deep v pr m sf |> x = + Deep (v `mappend` measure x) pr m (snocDigit sf x) snocDigit :: Digit a -> a -> Digit a snocDigit (One a) b = Two a b @@ -261,11 +363,14 @@ viewl :: (Measured v a) => FingerTree v a -> ViewL (FingerTree v) a viewl Empty = EmptyL viewl (Single x) = x :< Empty -viewl (Deep _ (One x) m sf) = x :< case viewl m of - EmptyL -> digitToTree sf - a :< m' -> deep (nodeToDigit a) m' sf -viewl (Deep _ pr m sf) = lheadDigit pr :< deep (ltailDigit pr) m sf +viewl (Deep _ (One x) m sf) = x :< rotL m sf +viewl (Deep _ pr m sf) = lheadDigit pr :< deep (ltailDigit pr) m sf +rotL :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> FingerTree v a +rotL m sf = case viewl m of + EmptyL -> digitToTree sf + a :< m' -> Deep (measure m `mappend` measure sf) (nodeToDigit a) m' sf + lheadDigit :: Digit a -> a lheadDigit (One a) = a lheadDigit (Two a _) = a @@ -281,10 +386,13 @@ viewr :: (Measured v a) => FingerTree v a -> ViewR (FingerTree v) a viewr Empty = EmptyR viewr (Single x) = Empty :> x -viewr (Deep _ pr m (One x)) = (case viewr m of +viewr (Deep _ pr m (One x)) = rotR pr m :> x +viewr (Deep _ pr m sf) = deep pr m (rtailDigit sf) :> rheadDigit sf + +rotR :: (Measured v a) => Digit a -> FingerTree v (Node v a) -> FingerTree v a +rotR pr m = case viewr m of EmptyR -> digitToTree pr - m' :> a -> deep pr m' (nodeToDigit a)) :> x -viewr (Deep _ pr m sf) = deep pr m (rtailDigit sf) :> rheadDigit sf + m' :> a -> Deep (measure pr `mappendVal` m) pr m' (nodeToDigit a) rheadDigit :: Digit a -> a rheadDigit (One a) = a @@ -584,16 +692,12 @@ deepL :: (Measured v a) => Maybe (Digit a) -> FingerTree v (Node v a) -> Digit a -> FingerTree v a -deepL Nothing m sf = case viewl m of - EmptyL -> digitToTree sf - a :< m' -> deep (nodeToDigit a) m' sf +deepL Nothing m sf = rotL m sf deepL (Just pr) m sf = deep pr m sf deepR :: (Measured v a) => Digit a -> FingerTree v (Node v a) -> Maybe (Digit a) -> FingerTree v a -deepR pr m Nothing = case viewr m of - EmptyR -> digitToTree pr - m' :> a -> deep pr m' (nodeToDigit a) +deepR pr m Nothing = rotR pr m deepR pr m (Just sf) = deep pr m sf splitNode :: (Measured v a) => (v -> Bool) -> v -> Node v a -> diff --git a/Data/IntervalMap/FingerTree.hs b/Data/IntervalMap/FingerTree.hs new file mode 100644 --- /dev/null +++ b/Data/IntervalMap/FingerTree.hs @@ -0,0 +1,186 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.PriorityQueue.FingerTree +-- Copyright : (c) Ross Paterson 2008 +-- License : BSD-style +-- Maintainer : ross@soi.city.ac.uk +-- Stability : experimental +-- Portability : non-portable (MPTCs and functional dependencies) +-- +-- Interval maps implemented using the 'FingerTree' type, following +-- section 4.8 of +-- +-- * Ralf Hinze and Ross Paterson, +-- \"Finger trees: a simple general-purpose data structure\", +-- /Journal of Functional Programming/ 16:2 (2006) pp 197-217. +-- +-- +-- An amortized running time is given for each operation, with /n/ +-- referring to the size of the priority queue. These bounds hold even +-- in a persistent (shared) setting. +-- +-- /Note/: Many of these operations have the same names as similar +-- operations on lists in the "Prelude". The ambiguity may be resolved +-- using either qualification or the @hiding@ clause. +-- +----------------------------------------------------------------------------- + +module Data.IntervalMap.FingerTree ( + -- * Intervals + Interval(..), point, + -- * Interval maps + IntervalMap, empty, singleton, insert, union, + -- * Searching + search, intersections, dominators + ) where + +import qualified Data.FingerTree as FT +import Data.FingerTree (FingerTree, Measured(..), ViewL(..), (<|), (><)) + +import Control.Applicative ((<$>)) +import Data.Traversable (Traversable(traverse)) +import Data.Foldable (Foldable(foldMap)) +import Data.Monoid + +---------------------------------- +-- 4.8 Application: interval trees +---------------------------------- + +-- | A closed interval. The lower bound should be less than or equal +-- to the higher bound. +data Interval v = Interval { low :: v, high :: v } + deriving (Eq, Ord, Show) + +-- | An interval in which the lower and upper bounds are equal. +point :: v -> Interval v +point v = Interval v v + +data Node v a = Node (Interval v) a + +instance Functor (Node v) where + fmap f (Node i x) = Node i (f x) + +instance Foldable (Node v) where + foldMap f (Node _ x) = f x + +instance Traversable (Node v) where + traverse f (Node i x) = Node i <$> f x + +-- rightmost interval (including largest lower bound) and largest upper bound. +data IntInterval v = NoInterval | IntInterval (Interval v) v + +instance Ord v => Monoid (IntInterval v) where + mempty = NoInterval + NoInterval `mappend` i = i + i `mappend` NoInterval = i + IntInterval _ hi1 `mappend` IntInterval int2 hi2 = + IntInterval int2 (max hi1 hi2) + +instance (Ord v) => Measured (IntInterval v) (Node v a) where + measure (Node i _) = IntInterval i (high i) + +-- | Map of closed intervals, possibly with duplicates. +-- The 'Foldable' and 'Traversable' instances process the intervals in +-- lexicographical order. +newtype IntervalMap v a = + IntervalMap (FingerTree (IntInterval v) (Node v a)) +-- ordered lexicographically by interval + +instance Functor (IntervalMap v) where + fmap f (IntervalMap t) = IntervalMap (FT.unsafeFmap (fmap f) t) + +instance Foldable (IntervalMap v) where + foldMap f (IntervalMap t) = foldMap (foldMap f) t + +instance Traversable (IntervalMap v) where + traverse f (IntervalMap t) = + IntervalMap <$> FT.unsafeTraverse (traverse f) t + +-- | /O(1)/. The empty interval map. +empty :: (Ord v) => IntervalMap v a +empty = IntervalMap FT.empty + +-- | /O(1)/. Interval map with a single entry. +singleton :: (Ord v) => Interval v -> a -> IntervalMap v a +singleton i x = IntervalMap (FT.singleton (Node i x)) + +-- | /O(log n)/. Insert an interval into a map. +-- The map may contain duplicate intervals; the new entry will be inserted +-- before any existing entries for the same interval. +insert :: (Ord v) => Interval v -> a -> IntervalMap v a -> IntervalMap v a +insert (Interval lo hi) x m | lo > hi = m +insert i x (IntervalMap t) = IntervalMap (l >< Node i x <| r) + where (l, r) = FT.split larger t + larger (IntInterval k _) = k >= i + +-- | /O(m log (n/\//m))/. Merge two interval maps. +-- The map may contain duplicate intervals; entries with equal intervals +-- are kept in the original order. +union :: (Ord v) => IntervalMap v a -> IntervalMap v a -> IntervalMap v a +union (IntervalMap xs) (IntervalMap ys) = IntervalMap (merge1 xs ys) + where merge1 as bs = case FT.viewl as of + EmptyL -> bs + a@(Node i _) :< as' -> l >< a <| merge2 as' r + where (l, r) = FT.split larger bs + larger (IntInterval k _) = k >= i + merge2 as bs = case FT.viewl bs of + EmptyL -> as + b@(Node i _) :< bs' -> l >< b <| merge1 r bs' + where (l, r) = FT.split larger as + larger (IntInterval k _) = k > i + +-- | /O(k log (n/\//k))/. All intervals that intersect with the given +-- interval, in lexicographical order. +intersections :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)] +intersections i = inRange (low i) (high i) + +-- | /O(k log (n/\//k))/. All intervals that contain the given interval, +-- in lexicographical order. +dominators :: (Ord v) => Interval v -> IntervalMap v a -> [(Interval v, a)] +dominators i = inRange (high i) (low i) + +-- | /O(k log (n/\//k))/. All intervals that contain the given point, +-- in lexicographical order. +search :: (Ord v) => v -> IntervalMap v a -> [(Interval v, a)] +search p = inRange p p + +-- | /O(k log (n/\//k))/. All intervals that intersect with the given +-- interval, in lexicographical order. +inRange :: (Ord v) => v -> v -> IntervalMap v a -> [(Interval v, a)] +inRange lo hi (IntervalMap t) = matches (FT.takeUntil (greater hi) t) + where matches xs = case FT.viewl (FT.dropUntil (atleast lo) xs) of + EmptyL -> [] + Node i x :< xs' -> (i, x) : matches xs' + +atleast :: (Ord v) => v -> IntInterval v -> Bool +atleast k (IntInterval _ hi) = k <= hi + +greater :: (Ord v) => v -> IntInterval v -> Bool +greater k (IntInterval i _) = low i > k + +mkMap :: (Ord v) => [(v, v, a)] -> IntervalMap v a +mkMap = foldr ins empty + where ins (lo, hi, n) = insert (Interval lo hi) n + +composers :: IntervalMap Int String +composers = mkMap [ + (1685, 1750, "Bach"), + (1685, 1759, "Handel"), + (1732, 1809, "Haydn"), + (1756, 1791, "Mozart"), + (1770, 1827, "Beethoven"), + (1782, 1840, "Paganini"), + (1797, 1828, "Schubert"), + (1803, 1869, "Berlioz"), + (1810, 1849, "Chopin"), + (1833, 1897, "Brahms"), + (1838, 1875, "Bizet")] + +mathematicians :: IntervalMap Int String +mathematicians = mkMap [ + (1642, 1727, "Newton"), + (1646, 1716, "Leibniz"), + (1707, 1783, "Euler"), + (1736, 1813, "Lagrange"), + (1777, 1855, "Gauss"), + (1811, 1831, "Galois")] diff --git a/Data/PriorityQueue/FingerTree.hs b/Data/PriorityQueue/FingerTree.hs new file mode 100644 --- /dev/null +++ b/Data/PriorityQueue/FingerTree.hs @@ -0,0 +1,174 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.PriorityQueue.FingerTree +-- Copyright : (c) Ross Paterson 2008 +-- License : BSD-style +-- Maintainer : ross@soi.city.ac.uk +-- Stability : experimental +-- Portability : non-portable (MPTCs and functional dependencies) +-- +-- Min-priority queues implemented using the 'FingerTree' type, +-- following section 4.6 of +-- +-- * Ralf Hinze and Ross Paterson, +-- \"Finger trees: a simple general-purpose data structure\", +-- /Journal of Functional Programming/ 16:2 (2006) pp 197-217. +-- +-- +-- These have the same big-O complexity as skew heap implementations, +-- but are approximately an order of magnitude slower. +-- On the other hand, they are stable, so they can be used for fair +-- queueing. They are also shallower, so that 'fmap' consumes less +-- space. +-- +-- An amortized running time is given for each operation, with /n/ +-- referring to the size of the priority queue. These bounds hold even +-- in a persistent (shared) setting. +-- +-- /Note/: Many of these operations have the same names as similar +-- operations on lists in the "Prelude". The ambiguity may be resolved +-- using either qualification or the @hiding@ clause. +-- +----------------------------------------------------------------------------- + +module Data.PriorityQueue.FingerTree ( + PQueue, + -- * Construction + empty, + singleton, + union, + insert, + add, + fromList, + -- * Deconstruction + null, + minView, + minViewWithKey + ) where + +import qualified Data.FingerTree as FT +import Data.FingerTree (FingerTree, (<|), (|>), (><), + ViewL(..), Measured(measure)) + +import Control.Arrow ((***)) +import Data.Foldable (Foldable(foldMap)) +import Data.Monoid +import Data.List (unfoldr) +import Prelude hiding (null) + +data Entry k v = Entry { key :: k, value :: v } + +instance Functor (Entry k) where + fmap f (Entry k v) = Entry k (f v) + +instance Foldable (Entry k) where + foldMap f (Entry _ v) = f v + +data Prio k v = NoPrio | Prio k v + +instance Ord k => Monoid (Prio k v) where + mempty = NoPrio + x `mappend` NoPrio = x + NoPrio `mappend` y = y + x@(Prio kx _) `mappend` y@(Prio ky _) + | kx <= ky = x + | otherwise = y + +instance Ord k => Measured (Prio k v) (Entry k v) where + measure (Entry k v) = Prio k v + +-- | Priority queues. +newtype PQueue k v = PQueue (FingerTree (Prio k v) (Entry k v)) + +instance Ord k => Functor (PQueue k) where + fmap f (PQueue xs) = PQueue (FT.fmap' (fmap f) xs) + +instance Ord k => Foldable (PQueue k) where + foldMap f q = case minView q of + Nothing -> mempty + Just (v, q') -> f v `mappend` foldMap f q' + +instance Ord k => Monoid (PQueue k v) where + mempty = empty + mappend = union + +-- | /O(1)/. The empty priority queue. +empty :: Ord k => PQueue k v +empty = PQueue FT.empty + +-- | /O(1)/. A singleton priority queue. +singleton :: Ord k => k -> v -> PQueue k v +singleton k v = PQueue (FT.singleton (Entry k v)) + +-- | /O(log n)/. Add a (priority, value) pair to the front of a priority queue. +-- +-- * @'insert' k v q = 'union' ('singleton' k v) q@ +-- +-- If @q@ contains entries with the same priority @k@, 'minView' of +-- @'insert' k v q@ will return them after this one. +insert :: Ord k => k -> v -> PQueue k v -> PQueue k v +insert k v (PQueue q) = PQueue (Entry k v <| q) + +-- | /O(log n)/. Add a (priority, value) pair to the back of a priority queue. +-- +-- * @'add' k v q = 'union' q ('singleton' k v)@ +-- +-- If @q@ contains entries with the same priority @k@, 'minView' of +-- @'add' k v q@ will return them before this one. +add :: Ord k => k -> v -> PQueue k v -> PQueue k v +add k v (PQueue q) = PQueue (q |> Entry k v) + +-- | /O(log(min(n1,n2)))/. Concatenate two priority queues. +-- 'union' is associative, with identity 'empty'. +-- +-- If there are entries with the same priority in both arguments, 'minView' +-- of @'union' xs ys@ will return those from @xs@ before those from @ys@. +union :: Ord k => PQueue k v -> PQueue k v -> PQueue k v +union (PQueue xs) (PQueue ys) = PQueue (xs >< ys) + +-- | /O(n)/. Create a priority queue from a finite list of priorities +-- and values. +fromList :: Ord k => [(k, v)] -> PQueue k v +fromList = foldr (uncurry insert) empty + +-- | /O(1)/. Is this the empty priority queue? +null :: Ord k => PQueue k v -> Bool +null (PQueue q) = FT.null q + +-- | /O(1)/ (/O(log(n))/ for the reduced queue). +-- Returns 'Nothing' for an empty map, or the value associated with the +-- minimal priority together with the rest of the priority queue. +-- +-- * @'minView' 'empty' = 'Nothing'@ +-- +-- * @'minView' ('singleton' k v) = 'Just' (v, 'empty')@ +-- +minView :: Ord k => PQueue k v -> Maybe (v, PQueue k v) +minView q = fmap (snd *** id) (minViewWithKey q) + +-- | /O(1)/ (/O(log(n))/ for the reduced queue). +-- Returns 'Nothing' for an empty map, or the minimal (priority, value) +-- pair together with the rest of the priority queue. +-- +-- * @'minViewWithKey' 'empty' = 'Nothing'@ +-- +-- * @'minViewWithKey' ('singleton' k v) = 'Just' ((k, v), 'empty')@ +-- +-- * If @'minViewWithKey' qi = 'Just' ((ki, vi), qi')@ and @k1 <= k2@, +-- then @'minViewWithKey' ('union' q1 q2) = 'Just' ((k1, v1), 'union' q1' q2)@ +-- +-- * If @'minViewWithKey' qi = 'Just' ((ki, vi), qi')@ and @k2 < k1@, +-- then @'minViewWithKey' ('union' q1 q2) = 'Just' ((k2, v2), 'union' q1 q2')@ +-- +minViewWithKey :: Ord k => PQueue k v -> Maybe ((k, v), PQueue k v) +minViewWithKey (PQueue q) + | FT.null q = Nothing + | otherwise = Just ((k, v), case FT.viewl r of + _ :< r' -> PQueue (l >< r') + _ -> error "can't happen") + where Prio k v = measure q + (l, r) = FT.split (below k) q + +below :: Ord k => k -> Prio k v -> Bool +below _ NoPrio = False +below k (Prio k' _) = k' <= k diff --git a/fingertree.cabal b/fingertree.cabal --- a/fingertree.cabal +++ b/fingertree.cabal @@ -1,24 +1,32 @@ -Name: fingertree -Version: 0.0 -Copyright: (c) 2006 Ross Paterson, Ralf Hinze -License: BSD3 -License-File: LICENSE -Maintainer: Ross Paterson -Category: Data Structures -Synopsis: Generic finger-tree structure +Name: fingertree +Version: 0.0.1.0 +Copyright: (c) 2006 Ross Paterson, Ralf Hinze +License: BSD3 +License-File: LICENSE +Maintainer: Ross Paterson +Category: Data Structures +Synopsis: Generic finger-tree structure, with example instances Description: - A general sequence representation with arbitrary - annotations, for use as a base for implementations of - various collection types, as described in section 4 of - . - * Ralf Hinze and Ross Paterson, - \"Finger trees: a simple general-purpose data structure\", - /Journal of Functional Programming/ 16:2 (2006) pp 197-217. - - . - For a directly usable sequence type, see "Data.Sequence" - in the @base@ package, which is a specialization of - this structure. -Exposed-Modules: Data.FingerTree -Build-Depends: base -Extensions: MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances + A general sequence representation with arbitrary + annotations, with example implementations of various + collection types, as described in section 4 of + . + * Ralf Hinze and Ross Paterson, + \"Finger trees: a simple general-purpose data structure\", + /Journal of Functional Programming/ 16:2 (2006) pp 197-217. + + . + For a tuned sequence type, see @Data.Sequence@ in the + @containers@ package, which is a specialization of + this structure. +Exposed-Modules: + Data.FingerTree + Data.IntervalMap.FingerTree + Data.PriorityQueue.FingerTree + -- Data.PrioritySearchQueue.FingerTree +Build-Type: Simple +Build-Depends: base < 6 +Extensions: MultiParamTypeClasses + FunctionalDependencies + FlexibleInstances + UndecidableInstances