fingertree 0.0 → 0.0.1.0
raw patch · 4 files changed
+519/−47 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Data.FingerTree: instance (Functor s) => Functor (ViewL s)
- Data.FingerTree: instance (Functor s) => Functor (ViewR s)
- Data.FingerTree: instance (Measured v a) => Measured v (Digit a)
- Data.FingerTree: instance (Measured v a) => Measured v (FingerTree v a)
- Data.FingerTree: instance (Monoid v) => Measured v (Node v a)
- Data.FingerTree: instance (Show a) => Show (Digit a)
+ Data.FingerTree: fmapWithPos :: (Measured v1 a1, Measured v2 a2) => (v1 -> a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2
+ Data.FingerTree: instance Functor s => Functor (ViewL s)
+ Data.FingerTree: instance Functor s => Functor (ViewR s)
+ Data.FingerTree: instance Measured v a => Measured v (Digit a)
+ Data.FingerTree: instance Measured v a => Measured v (FingerTree v a)
+ Data.FingerTree: instance Measured v a => Monoid (FingerTree v a)
+ Data.FingerTree: instance Monoid v => Measured v (Node v a)
+ Data.FingerTree: instance Show a => Show (Digit a)
+ Data.FingerTree: traverseWithPos :: (Measured v1 a1, Measured v2 a2, Applicative f) => (v1 -> a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)
+ Data.FingerTree: unsafeFmap :: (a -> b) -> FingerTree v a -> FingerTree v b
+ Data.FingerTree: unsafeTraverse :: Applicative f => (a -> f b) -> FingerTree v a -> f (FingerTree v b)
+ Data.IntervalMap.FingerTree: Interval :: v -> v -> Interval v
+ Data.IntervalMap.FingerTree: data Interval v
+ Data.IntervalMap.FingerTree: data IntervalMap v a
+ Data.IntervalMap.FingerTree: dominators :: Ord v => Interval v -> IntervalMap v a -> [(Interval v, a)]
+ Data.IntervalMap.FingerTree: empty :: Ord v => IntervalMap v a
+ Data.IntervalMap.FingerTree: high :: Interval v -> v
+ Data.IntervalMap.FingerTree: insert :: Ord v => Interval v -> a -> IntervalMap v a -> IntervalMap v a
+ Data.IntervalMap.FingerTree: instance Eq v => Eq (Interval v)
+ Data.IntervalMap.FingerTree: instance Foldable (IntervalMap v)
+ Data.IntervalMap.FingerTree: instance Foldable (Node v)
+ Data.IntervalMap.FingerTree: instance Functor (IntervalMap v)
+ Data.IntervalMap.FingerTree: instance Functor (Node v)
+ Data.IntervalMap.FingerTree: instance Ord v => Measured (IntInterval v) (Node v a)
+ Data.IntervalMap.FingerTree: instance Ord v => Monoid (IntInterval v)
+ Data.IntervalMap.FingerTree: instance Ord v => Ord (Interval v)
+ Data.IntervalMap.FingerTree: instance Show v => Show (Interval v)
+ Data.IntervalMap.FingerTree: instance Traversable (IntervalMap v)
+ Data.IntervalMap.FingerTree: instance Traversable (Node v)
+ Data.IntervalMap.FingerTree: intersections :: Ord v => Interval v -> IntervalMap v a -> [(Interval v, a)]
+ Data.IntervalMap.FingerTree: low :: Interval v -> v
+ Data.IntervalMap.FingerTree: point :: v -> Interval v
+ Data.IntervalMap.FingerTree: search :: Ord v => v -> IntervalMap v a -> [(Interval v, a)]
+ Data.IntervalMap.FingerTree: singleton :: Ord v => Interval v -> a -> IntervalMap v a
+ Data.IntervalMap.FingerTree: union :: Ord v => IntervalMap v a -> IntervalMap v a -> IntervalMap v a
+ Data.PriorityQueue.FingerTree: add :: Ord k => k -> v -> PQueue k v -> PQueue k v
+ Data.PriorityQueue.FingerTree: data PQueue k v
+ Data.PriorityQueue.FingerTree: empty :: Ord k => PQueue k v
+ Data.PriorityQueue.FingerTree: fromList :: Ord k => [(k, v)] -> PQueue k v
+ Data.PriorityQueue.FingerTree: insert :: Ord k => k -> v -> PQueue k v -> PQueue k v
+ Data.PriorityQueue.FingerTree: instance Foldable (Entry k)
+ Data.PriorityQueue.FingerTree: instance Functor (Entry k)
+ Data.PriorityQueue.FingerTree: instance Ord k => Foldable (PQueue k)
+ Data.PriorityQueue.FingerTree: instance Ord k => Functor (PQueue k)
+ Data.PriorityQueue.FingerTree: instance Ord k => Measured (Prio k v) (Entry k v)
+ Data.PriorityQueue.FingerTree: instance Ord k => Monoid (PQueue k v)
+ Data.PriorityQueue.FingerTree: instance Ord k => Monoid (Prio k v)
+ Data.PriorityQueue.FingerTree: minView :: Ord k => PQueue k v -> Maybe (v, PQueue k v)
+ Data.PriorityQueue.FingerTree: minViewWithKey :: Ord k => PQueue k v -> Maybe ((k, v), PQueue k v)
+ Data.PriorityQueue.FingerTree: null :: Ord k => PQueue k v -> Bool
+ Data.PriorityQueue.FingerTree: singleton :: Ord k => k -> v -> PQueue k v
+ Data.PriorityQueue.FingerTree: union :: Ord k => PQueue k v -> PQueue k v -> PQueue k v
- Data.FingerTree: (<|) :: (Measured v a) => a -> FingerTree v a -> FingerTree v a
+ Data.FingerTree: (<|) :: Measured v a => a -> FingerTree v a -> FingerTree v a
- Data.FingerTree: (><) :: (Measured v a) => FingerTree v a -> FingerTree v a -> FingerTree v a
+ Data.FingerTree: (><) :: Measured v a => FingerTree v a -> FingerTree v a -> FingerTree v a
- Data.FingerTree: (|>) :: (Measured v a) => FingerTree v a -> a -> FingerTree v a
+ Data.FingerTree: (|>) :: Measured v a => FingerTree v a -> a -> FingerTree v a
- Data.FingerTree: class (Monoid v) => Measured v a | a -> v
+ Data.FingerTree: class Monoid v => Measured v a | a -> v
- Data.FingerTree: dropUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
+ Data.FingerTree: dropUntil :: Measured v a => (v -> Bool) -> FingerTree v a -> FingerTree v a
- Data.FingerTree: empty :: (Measured v a) => FingerTree v a
+ Data.FingerTree: empty :: Measured v a => FingerTree v a
- Data.FingerTree: fromList :: (Measured v a) => [a] -> FingerTree v a
+ Data.FingerTree: fromList :: Measured v a => [a] -> FingerTree v a
- Data.FingerTree: measure :: (Measured v a) => a -> v
+ Data.FingerTree: measure :: Measured v a => a -> v
- Data.FingerTree: null :: (Measured v a) => FingerTree v a -> Bool
+ Data.FingerTree: null :: Measured v a => FingerTree v a -> Bool
- Data.FingerTree: reverse :: (Measured v a) => FingerTree v a -> FingerTree v a
+ Data.FingerTree: reverse :: Measured v a => FingerTree v a -> FingerTree v a
- Data.FingerTree: singleton :: (Measured v a) => a -> FingerTree v a
+ Data.FingerTree: singleton :: Measured v a => a -> FingerTree v a
- Data.FingerTree: split :: (Measured v a) => (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
+ Data.FingerTree: split :: Measured v a => (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)
- Data.FingerTree: takeUntil :: (Measured v a) => (v -> Bool) -> FingerTree v a -> FingerTree v a
+ Data.FingerTree: takeUntil :: Measured v a => (v -> Bool) -> FingerTree v a -> FingerTree v a
- Data.FingerTree: viewl :: (Measured v a) => FingerTree v a -> ViewL (FingerTree v) a
+ Data.FingerTree: viewl :: Measured v a => FingerTree v a -> ViewL (FingerTree v) a
- Data.FingerTree: viewr :: (Measured v a) => FingerTree v a -> ViewR (FingerTree v) a
+ Data.FingerTree: viewr :: Measured v a => FingerTree v a -> ViewR (FingerTree v) a
Files
- Data/FingerTree.hs +128/−24
- Data/IntervalMap/FingerTree.hs +186/−0
- Data/PriorityQueue/FingerTree.hs +174/−0
- fingertree.cabal +31/−23
Data/FingerTree.hs view
@@ -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 ->
+ Data/IntervalMap/FingerTree.hs view
@@ -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.+-- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>+--+-- 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")]
+ Data/PriorityQueue/FingerTree.hs view
@@ -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.+-- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>+--+-- 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
fingertree.cabal view
@@ -1,24 +1,32 @@-Name: fingertree-Version: 0.0-Copyright: (c) 2006 Ross Paterson, Ralf Hinze-License: BSD3-License-File: LICENSE-Maintainer: Ross Paterson <ross@soi.city.ac.uk>-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 <ross@soi.city.ac.uk>+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.- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>- .- 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.+ <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>+ .+ 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