packages feed

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 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