fingertree 0.1.0.0 → 0.1.0.1
raw patch · 4 files changed
+428/−395 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Data/FingerTree.hs +311/−292
- Data/IntervalMap/FingerTree.hs +77/−62
- Data/PriorityQueue/FingerTree.hs +39/−40
- fingertree.cabal +1/−1
Data/FingerTree.hs view
@@ -12,10 +12,10 @@ -- 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>+-- * Ralf Hinze and Ross Paterson,+-- \"Finger trees: a simple general-purpose data structure\",+-- /Journal of Functional Programming/ 16:2 (2006) pp 197-217.+-- <http://staff.city.ac.uk/~ross/papers/FingerTree.html> -- -- For a directly usable sequence type, see @Data.Sequence@, which is -- a specialization of this structure.@@ -32,26 +32,26 @@ module Data.FingerTree ( #if TESTING- FingerTree(..), Digit(..), Node(..), deep, node2, node3,+ FingerTree(..), Digit(..), Node(..), deep, node2, node3, #else- FingerTree,+ FingerTree, #endif- Measured(..),- -- * Construction- empty, singleton,- (<|), (|>), (><),- fromList,- -- * Deconstruction- null,- ViewL(..), ViewR(..), viewl, viewr,- split, takeUntil, dropUntil,- -- * Transformation- reverse,- fmap', fmapWithPos, unsafeFmap,- traverse', traverseWithPos, unsafeTraverse- -- * Example- -- $example- ) where+ Measured(..),+ -- * Construction+ empty, singleton,+ (<|), (|>), (><),+ fromList,+ -- * Deconstruction+ null,+ ViewL(..), ViewR(..), viewl, viewr,+ split, takeUntil, dropUntil,+ -- * Transformation+ reverse,+ fmap', fmapWithPos, unsafeFmap,+ traverse', traverseWithPos, unsafeTraverse+ -- * Example+ -- $example+ ) where import Prelude hiding (null, reverse) @@ -65,44 +65,44 @@ -- | View of the left end of a sequence. data ViewL s a- = EmptyL -- ^ empty sequence- | a :< s a -- ^ leftmost element and the rest of the sequence- deriving (Eq, Ord, Show, Read)+ = EmptyL -- ^ empty sequence+ | a :< s a -- ^ leftmost element and the rest of the sequence+ deriving (Eq, Ord, Show, Read) -- | View of the right end of a sequence. data ViewR s a- = EmptyR -- ^ empty sequence- | s a :> a -- ^ the sequence minus the rightmost element,- -- and the rightmost element- deriving (Eq, Ord, Show, Read)+ = EmptyR -- ^ empty sequence+ | s a :> a -- ^ the sequence minus the rightmost element,+ -- and the rightmost element+ deriving (Eq, Ord, Show, Read) instance Functor s => Functor (ViewL s) where- fmap _ EmptyL = EmptyL- fmap f (x :< xs) = f x :< fmap f xs+ fmap _ EmptyL = EmptyL+ fmap f (x :< xs) = f x :< fmap f xs instance Functor s => Functor (ViewR s) where- fmap _ EmptyR = EmptyR- fmap f (xs :> x) = fmap f xs :> f x+ fmap _ EmptyR = EmptyR+ fmap f (xs :> x) = fmap f xs :> f x -- | 'empty' and '><'. instance Measured v a => Monoid (FingerTree v a) where- mempty = empty- mappend = (><)+ mempty = empty+ mappend = (><) -- Explicit Digit type (Exercise 1) data Digit a- = One a- | Two a a- | Three a a a- | Four a a a a- deriving Show+ = One a+ | Two a a+ | Three a a a+ | Four a a a a+ deriving Show instance Foldable Digit where- foldMap f (One a) = f a- foldMap f (Two a b) = f a `mappend` f b- foldMap f (Three a b c) = f a `mappend` f b `mappend` f c- foldMap f (Four a b c d) = f a `mappend` f b `mappend` f c `mappend` f d+ foldMap f (One a) = f a+ foldMap f (Two a b) = f a `mappend` f b+ foldMap f (Three a b c) = f a `mappend` f b `mappend` f c+ foldMap f (Four a b c d) = f a `mappend` f b `mappend` f c `mappend` f d ------------------- -- 4.1 Measurements@@ -110,21 +110,21 @@ -- | Things that can be measured. class (Monoid v) => Measured v a | a -> v where- measure :: a -> v+ measure :: a -> v instance (Measured v a) => Measured v (Digit a) where- measure = foldMap measure+ measure = foldMap measure --------------------------- -- 4.2 Caching measurements --------------------------- data Node v a = Node2 !v a a | Node3 !v a a a- deriving Show+ deriving Show instance Foldable (Node v) where- foldMap f (Node2 _ a b) = f a `mappend` f b- foldMap f (Node3 _ a b c) = f a `mappend` f b `mappend` f c+ foldMap f (Node2 _ a b) = f a `mappend` f b+ foldMap f (Node3 _ a b c) = f a `mappend` f b `mappend` f c node2 :: (Measured v a) => a -> a -> Node v a node2 a b = Node2 (measure a `mappend` measure b) a b@@ -133,8 +133,8 @@ node3 a b c = Node3 (measure a `mappend` measure b `mappend` measure c) a b c instance (Monoid v) => Measured v (Node v a) where- measure (Node2 v _ _) = v- measure (Node3 v _ _ _) = v+ measure (Node2 v _ _) = v+ measure (Node3 v _ _ _) = v nodeToDigit :: Node v a -> Digit a nodeToDigit (Node2 _ a b) = Two a b@@ -152,55 +152,55 @@ -- A variety of abstract data types can be implemented by using different -- element types and measurements. data FingerTree v a- = Empty- | Single a- | Deep !v !(Digit a) (FingerTree v (Node v a)) !(Digit a)+ = Empty+ | Single a+ | Deep !v !(Digit a) (FingerTree v (Node v a)) !(Digit a) #if TESTING- deriving Show+ deriving Show #endif -deep :: (Measured v a) => - Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a+deep :: (Measured v a) =>+ Digit a -> FingerTree v (Node v a) -> Digit a -> FingerTree v a deep pr m sf = Deep ((measure pr `mappendVal` m) `mappend` measure sf) pr m sf -- | /O(1)/. The cached measure of a tree. instance (Measured v a) => Measured v (FingerTree v a) where- measure Empty = mempty- measure (Single x) = measure x- measure (Deep v _ _ _) = v+ measure Empty = mempty+ measure (Single x) = measure x+ measure (Deep v _ _ _) = v instance Foldable (FingerTree v) where- foldMap _ Empty = mempty- foldMap f (Single x) = f x- foldMap f (Deep _ pr m sf) =- foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf+ foldMap _ Empty = mempty+ foldMap f (Single x) = f x+ foldMap f (Deep _ pr m sf) =+ foldMap f pr `mappend` foldMap (foldMap f) m `mappend` foldMap f sf instance Eq a => Eq (FingerTree v a) where- xs == ys = toList xs == toList ys+ xs == ys = toList xs == toList ys instance Ord a => Ord (FingerTree v a) where- compare xs ys = compare (toList xs) (toList ys)+ compare xs ys = compare (toList xs) (toList ys) #if !TESTING instance Show a => Show (FingerTree v a) where- showsPrec p xs = showParen (p > 10) $- showString "fromList " . shows (toList xs)+ showsPrec p xs = showParen (p > 10) $+ showString "fromList " . shows (toList xs) #endif -- | Like 'fmap', but with a more constrained type. fmap' :: (Measured v1 a1, Measured v2 a2) =>- (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2+ (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2 fmap' = mapTree mapTree :: (Measured v2 a2) =>- (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2+ (a1 -> a2) -> FingerTree v1 a1 -> FingerTree v2 a2 mapTree _ Empty = Empty mapTree f (Single x) = Single (f x) mapTree f (Deep _ pr m sf) =- deep (mapDigit f pr) (mapTree (mapNode f) m) (mapDigit f sf)+ deep (mapDigit f pr) (mapTree (mapNode f) m) (mapDigit f sf) mapNode :: (Measured v2 a2) =>- (a1 -> a2) -> Node v1 a1 -> Node v2 a2+ (a1 -> a2) -> Node v1 a1 -> Node v2 a2 mapNode f (Node2 _ a b) = node2 (f a) (f b) mapNode f (Node3 _ a b c) = node3 (f a) (f b) (f c) @@ -213,46 +213,52 @@ -- | 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+ (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+ (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+ 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+ (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+ 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+ 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+ 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+ 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+ 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)+ 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)@@ -260,18 +266,18 @@ -- | 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)+ (a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2) traverse' = traverseTree traverseTree :: (Measured v2 a2, Applicative f) =>- (a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2)+ (a1 -> f a2) -> FingerTree v1 a1 -> f (FingerTree v2 a2) traverseTree _ Empty = pure Empty traverseTree f (Single x) = Single <$> f x traverseTree f (Deep _ pr m sf) =- deep <$> traverseDigit f pr <*> traverseTree (traverseNode f) m <*> traverseDigit f sf+ deep <$> traverseDigit f pr <*> traverseTree (traverseNode f) m <*> traverseDigit f sf traverseNode :: (Measured v2 a2, Applicative f) =>- (a1 -> f a2) -> Node v1 a1 -> f (Node v2 a2)+ (a1 -> f a2) -> Node v1 a1 -> f (Node v2 a2) traverseNode f (Node2 _ a b) = node2 <$> f a <*> f b traverseNode f (Node3 _ a b c) = node3 <$> f a <*> f b <*> f c @@ -284,49 +290,55 @@ -- | 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)+ (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)+ (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+ 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)+ (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+ 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+ 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)+ (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+ 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+ 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+ 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)+ (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+ 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)+ (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 @@ -343,18 +355,18 @@ singleton = Single -- | /O(n)/. Create a sequence from a finite list of elements.-fromList :: (Measured v a) => [a] -> FingerTree v a +fromList :: (Measured v a) => [a] -> FingerTree v a fromList = foldr (<|) Empty -- | /O(1)/. Add an element to the left end of a sequence. -- Mnemonic: a triangle with the single element at the pointy end. (<|) :: (Measured v a) => a -> FingerTree v a -> FingerTree v a-a <| Empty = Single a-a <| Single b = deep (One a) Empty (One b)+a <| Empty = Single a+a <| Single b = deep (One a) Empty (One b) 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+ 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@@ -365,12 +377,12 @@ -- | /O(1)/. Add an element to the right end of a sequence. -- Mnemonic: a triangle with the single element at the pointy end. (|>) :: (Measured v a) => FingerTree v a -> a -> FingerTree v a-Empty |> a = Single a-Single a |> b = deep (One a) Empty (One b)+Empty |> a = Single a+Single a |> b = deep (One a) Empty (One b) 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)+ 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@@ -385,15 +397,15 @@ -- | /O(1)/. Analyse the left end of a sequence. 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 :< rotL m sf-viewl (Deep _ pr m sf) = lheadDigit pr :< deep (ltailDigit pr) m sf+viewl Empty = EmptyL+viewl (Single x) = x :< Empty+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+ EmptyL -> digitToTree sf+ a :< m' -> Deep (measure m `mappend` measure sf) (nodeToDigit a) m' sf lheadDigit :: Digit a -> a lheadDigit (One a) = a@@ -406,18 +418,18 @@ ltailDigit (Two _ b) = One b ltailDigit (Three _ b c) = Two b c ltailDigit (Four _ b c d) = Three b c d- + -- | /O(1)/. Analyse the right end of a sequence. 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)) = rotR pr m :> x-viewr (Deep _ pr m sf) = deep pr m (rtailDigit sf) :> rheadDigit sf+viewr Empty = EmptyR+viewr (Single x) = Empty :> x+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 (measure pr `mappendVal` m) pr m' (nodeToDigit a)+ EmptyR -> digitToTree pr+ m' :> a -> Deep (measure pr `mappendVal` m) pr m' (nodeToDigit a) rheadDigit :: Digit a -> a rheadDigit (One a) = a@@ -447,233 +459,233 @@ appendTree0 :: (Measured v a) => FingerTree v a -> FingerTree v a -> FingerTree v a appendTree0 Empty xs =- xs+ xs appendTree0 xs Empty =- xs+ xs appendTree0 (Single x) xs =- x <| xs+ x <| xs appendTree0 xs (Single x) =- xs |> x+ xs |> x appendTree0 (Deep _ pr1 m1 sf1) (Deep _ pr2 m2 sf2) =- deep pr1 (addDigits0 m1 sf1 pr2 m2) sf2+ deep pr1 (addDigits0 m1 sf1 pr2 m2) sf2 addDigits0 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a) addDigits0 m1 (One a) (One b) m2 =- appendTree1 m1 (node2 a b) m2+ appendTree1 m1 (node2 a b) m2 addDigits0 m1 (One a) (Two b c) m2 =- appendTree1 m1 (node3 a b c) m2+ appendTree1 m1 (node3 a b c) m2 addDigits0 m1 (One a) (Three b c d) m2 =- appendTree2 m1 (node2 a b) (node2 c d) m2+ appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (One a) (Four b c d e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Two a b) (One c) m2 =- appendTree1 m1 (node3 a b c) m2+ appendTree1 m1 (node3 a b c) m2 addDigits0 m1 (Two a b) (Two c d) m2 =- appendTree2 m1 (node2 a b) (node2 c d) m2+ appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (Two a b) (Three c d e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Two a b) (Four c d e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Three a b c) (One d) m2 =- appendTree2 m1 (node2 a b) (node2 c d) m2+ appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits0 m1 (Three a b c) (Two d e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Three a b c) (Three d e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Three a b c) (Four d e f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits0 m1 (Four a b c d) (One e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits0 m1 (Four a b c d) (Two e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits0 m1 (Four a b c d) (Three e f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits0 m1 (Four a b c d) (Four e f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 appendTree1 :: (Measured v a) => FingerTree v a -> a -> FingerTree v a -> FingerTree v a appendTree1 Empty a xs =- a <| xs+ a <| xs appendTree1 xs a Empty =- xs |> a+ xs |> a appendTree1 (Single x) a xs =- x <| a <| xs+ x <| a <| xs appendTree1 xs a (Single x) =- xs |> a |> x+ xs |> a |> x appendTree1 (Deep _ pr1 m1 sf1) a (Deep _ pr2 m2 sf2) =- deep pr1 (addDigits1 m1 sf1 a pr2 m2) sf2+ deep pr1 (addDigits1 m1 sf1 a pr2 m2) sf2 addDigits1 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a) addDigits1 m1 (One a) b (One c) m2 =- appendTree1 m1 (node3 a b c) m2+ appendTree1 m1 (node3 a b c) m2 addDigits1 m1 (One a) b (Two c d) m2 =- appendTree2 m1 (node2 a b) (node2 c d) m2+ appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits1 m1 (One a) b (Three c d e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (One a) b (Four c d e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Two a b) c (One d) m2 =- appendTree2 m1 (node2 a b) (node2 c d) m2+ appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits1 m1 (Two a b) c (Two d e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (Two a b) c (Three d e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Two a b) c (Four d e f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Three a b c) d (One e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits1 m1 (Three a b c) d (Two e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Three a b c) d (Three e f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Three a b c) d (Four e f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits1 m1 (Four a b c d) e (One f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits1 m1 (Four a b c d) e (Two f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits1 m1 (Four a b c d) e (Three f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits1 m1 (Four a b c d) e (Four f g h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 appendTree2 :: (Measured v a) => FingerTree v a -> a -> a -> FingerTree v a -> FingerTree v a appendTree2 Empty a b xs =- a <| b <| xs+ a <| b <| xs appendTree2 xs a b Empty =- xs |> a |> b+ xs |> a |> b appendTree2 (Single x) a b xs =- x <| a <| b <| xs+ x <| a <| b <| xs appendTree2 xs a b (Single x) =- xs |> a |> b |> x+ xs |> a |> b |> x appendTree2 (Deep _ pr1 m1 sf1) a b (Deep _ pr2 m2 sf2) =- deep pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2+ deep pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2 addDigits2 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a) addDigits2 m1 (One a) b c (One d) m2 =- appendTree2 m1 (node2 a b) (node2 c d) m2+ appendTree2 m1 (node2 a b) (node2 c d) m2 addDigits2 m1 (One a) b c (Two d e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits2 m1 (One a) b c (Three d e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (One a) b c (Four d e f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Two a b) c d (One e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits2 m1 (Two a b) c d (Two e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (Two a b) c d (Three e f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Two a b) c d (Four e f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Three a b c) d e (One f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits2 m1 (Three a b c) d e (Two f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Three a b c) d e (Three f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Three a b c) d e (Four f g h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits2 m1 (Four a b c d) e f (One g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits2 m1 (Four a b c d) e f (Two g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits2 m1 (Four a b c d) e f (Three g h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits2 m1 (Four a b c d) e f (Four g h i j) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 appendTree3 :: (Measured v a) => FingerTree v a -> a -> a -> a -> FingerTree v a -> FingerTree v a appendTree3 Empty a b c xs =- a <| b <| c <| xs+ a <| b <| c <| xs appendTree3 xs a b c Empty =- xs |> a |> b |> c+ xs |> a |> b |> c appendTree3 (Single x) a b c xs =- x <| a <| b <| c <| xs+ x <| a <| b <| c <| xs appendTree3 xs a b c (Single x) =- xs |> a |> b |> c |> x+ xs |> a |> b |> c |> x appendTree3 (Deep _ pr1 m1 sf1) a b c (Deep _ pr2 m2 sf2) =- deep pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2+ deep pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2 addDigits3 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a) addDigits3 m1 (One a) b c d (One e) m2 =- appendTree2 m1 (node3 a b c) (node2 d e) m2+ appendTree2 m1 (node3 a b c) (node2 d e) m2 addDigits3 m1 (One a) b c d (Two e f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits3 m1 (One a) b c d (Three e f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (One a) b c d (Four e f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Two a b) c d e (One f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits3 m1 (Two a b) c d e (Two f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (Two a b) c d e (Three f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Two a b) c d e (Four f g h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Three a b c) d e f (One g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits3 m1 (Three a b c) d e f (Two g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Three a b c) d e f (Three g h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Three a b c) d e f (Four g h i j) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits3 m1 (Four a b c d) e f g (One h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits3 m1 (Four a b c d) e f g (Two h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits3 m1 (Four a b c d) e f g (Three h i j) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits3 m1 (Four a b c d) e f g (Four h i j k) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 appendTree4 :: (Measured v a) => FingerTree v a -> a -> a -> a -> a -> FingerTree v a -> FingerTree v a appendTree4 Empty a b c d xs =- a <| b <| c <| d <| xs+ a <| b <| c <| d <| xs appendTree4 xs a b c d Empty =- xs |> a |> b |> c |> d+ xs |> a |> b |> c |> d appendTree4 (Single x) a b c d xs =- x <| a <| b <| c <| d <| xs+ x <| a <| b <| c <| d <| xs appendTree4 xs a b c d (Single x) =- xs |> a |> b |> c |> d |> x+ xs |> a |> b |> c |> d |> x appendTree4 (Deep _ pr1 m1 sf1) a b c d (Deep _ pr2 m2 sf2) =- deep pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2+ deep pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2 addDigits4 :: (Measured v a) => FingerTree v (Node v a) -> Digit a -> a -> a -> a -> a -> Digit a -> FingerTree v (Node v a) -> FingerTree v (Node v a) addDigits4 m1 (One a) b c d e (One f) m2 =- appendTree2 m1 (node3 a b c) (node3 d e f) m2+ appendTree2 m1 (node3 a b c) (node3 d e f) m2 addDigits4 m1 (One a) b c d e (Two f g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits4 m1 (One a) b c d e (Three f g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (One a) b c d e (Four f g h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Two a b) c d e f (One g) m2 =- appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2+ appendTree3 m1 (node3 a b c) (node2 d e) (node2 f g) m2 addDigits4 m1 (Two a b) c d e f (Two g h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (Two a b) c d e f (Three g h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Two a b) c d e f (Four g h i j) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Three a b c) d e f g (One h) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node2 g h) m2 addDigits4 m1 (Three a b c) d e f g (Two h i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Three a b c) d e f g (Three h i j) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Three a b c) d e f g (Four h i j k) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 addDigits4 m1 (Four a b c d) e f g h (One i) m2 =- appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2+ appendTree3 m1 (node3 a b c) (node3 d e f) (node3 g h i) m2 addDigits4 m1 (Four a b c d) e f g h (Two i j) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node2 g h) (node2 i j) m2 addDigits4 m1 (Four a b c d) e f g h (Three i j k) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node2 j k) m2 addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 =- appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2+ appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2 ---------------- -- 4.4 Splitting@@ -684,13 +696,14 @@ -- -- For predictable results, one should ensure that there is only one such -- point, i.e. that the predicate is /monotonic/.-split :: (Measured v a) => - (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a)+split :: (Measured v a) =>+ (v -> Bool) -> FingerTree v a -> (FingerTree v a, FingerTree v a) split _ Empty = (Empty, Empty) split p xs | p (measure xs) = (l, x <| r)- | otherwise = (xs, Empty)- where Split l x r = splitTree p mempty xs+ | otherwise = (xs, Empty)+ where+ Split l x r = splitTree p mempty xs -- | /O(log(min(i,n-i)))/. -- Given a monotonic predicate @p@, @'takeUntil' p t@ is the largest@@ -710,70 +723,76 @@ data Split t a = Split t a t -splitTree :: (Measured v a) => - (v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a+splitTree :: (Measured v a) =>+ (v -> Bool) -> v -> FingerTree v a -> Split (FingerTree v a) a splitTree _ _ Empty = illegal_argument "splitTree" splitTree _ _ (Single x) = Split Empty x Empty splitTree p i (Deep _ pr m sf)- | p vpr = let Split l x r = splitDigit p i pr- in Split (maybe Empty digitToTree l) x (deepL r m sf)- | p vm = let Split ml xs mr = splitTree p vpr m- Split l x r = splitNode p (vpr `mappendVal` ml) xs- in Split (deepR pr ml l) x (deepL r mr sf)- | otherwise = let Split l x r = splitDigit p vm sf- in Split (deepR pr m l) x (maybe Empty digitToTree r)- where vpr = i `mappend` measure pr- vm = vpr `mappendVal` m+ | p vpr = let Split l x r = splitDigit p i pr+ in Split (maybe Empty digitToTree l) x (deepL r m sf)+ | p vm = let Split ml xs mr = splitTree p vpr m+ Split l x r = splitNode p (vpr `mappendVal` ml) xs+ in Split (deepR pr ml l) x (deepL r mr sf)+ | otherwise = let Split l x r = splitDigit p vm sf+ in Split (deepR pr m l) x (maybe Empty digitToTree r)+ where+ vpr = i `mappend` measure pr+ vm = vpr `mappendVal` m -- Avoid relying on right identity (cf Exercise 7) mappendVal :: (Measured v a) => v -> FingerTree v a -> v mappendVal v Empty = v mappendVal v t = v `mappend` measure t -deepL :: (Measured v a) =>- Maybe (Digit a) -> FingerTree v (Node v a) -> Digit a -> FingerTree v a-deepL Nothing m sf = rotL m sf-deepL (Just pr) m sf = deep pr m sf+deepL :: (Measured v a) =>+ Maybe (Digit a) -> FingerTree v (Node v a) -> Digit a -> FingerTree v a+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 = rotR pr m-deepR pr m (Just 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 = rotR pr m+deepR pr m (Just sf) = deep pr m sf splitNode :: (Measured v a) => (v -> Bool) -> v -> Node v a ->- Split (Maybe (Digit a)) a+ Split (Maybe (Digit a)) a splitNode p i (Node2 _ a b)- | p va = Split Nothing a (Just (One b))- | otherwise = Split (Just (One a)) b Nothing- where va = i `mappend` measure a+ | p va = Split Nothing a (Just (One b))+ | otherwise = Split (Just (One a)) b Nothing+ where+ va = i `mappend` measure a splitNode p i (Node3 _ a b c)- | p va = Split Nothing a (Just (Two b c))- | p vab = Split (Just (One a)) b (Just (One c))- | otherwise = Split (Just (Two a b)) c Nothing- where va = i `mappend` measure a- vab = va `mappend` measure b+ | p va = Split Nothing a (Just (Two b c))+ | p vab = Split (Just (One a)) b (Just (One c))+ | otherwise = Split (Just (Two a b)) c Nothing+ where+ va = i `mappend` measure a+ vab = va `mappend` measure b splitDigit :: (Measured v a) => (v -> Bool) -> v -> Digit a ->- Split (Maybe (Digit a)) a+ Split (Maybe (Digit a)) a splitDigit _ i (One a) = i `seq` Split Nothing a Nothing splitDigit p i (Two a b)- | p va = Split Nothing a (Just (One b))- | otherwise = Split (Just (One a)) b Nothing- where va = i `mappend` measure a+ | p va = Split Nothing a (Just (One b))+ | otherwise = Split (Just (One a)) b Nothing+ where+ va = i `mappend` measure a splitDigit p i (Three a b c)- | p va = Split Nothing a (Just (Two b c))- | p vab = Split (Just (One a)) b (Just (One c))- | otherwise = Split (Just (Two a b)) c Nothing- where va = i `mappend` measure a- vab = va `mappend` measure b+ | p va = Split Nothing a (Just (Two b c))+ | p vab = Split (Just (One a)) b (Just (One c))+ | otherwise = Split (Just (Two a b)) c Nothing+ where+ va = i `mappend` measure a+ vab = va `mappend` measure b splitDigit p i (Four a b c d)- | p va = Split Nothing a (Just (Three b c d))- | p vab = Split (Just (One a)) b (Just (Two c d))- | p vabc = Split (Just (Two a b)) c (Just (One d))- | otherwise = Split (Just (Three a b c)) d Nothing- where va = i `mappend` measure a- vab = va `mappend` measure b- vabc = vab `mappend` measure c+ | p va = Split Nothing a (Just (Three b c d))+ | p vab = Split (Just (One a)) b (Just (Two c d))+ | p vabc = Split (Just (Two a b)) c (Just (One d))+ | otherwise = Split (Just (Three a b c)) d Nothing+ where+ va = i `mappend` measure a+ vab = va `mappend` measure b+ vabc = vab `mappend` measure c ------------------ -- Transformations@@ -787,7 +806,7 @@ reverseTree _ Empty = Empty reverseTree f (Single x) = Single (f x) reverseTree f (Deep _ pr m sf) =- deep (reverseDigit f sf) (reverseTree (reverseNode f) m) (reverseDigit f pr)+ deep (reverseDigit f sf) (reverseTree (reverseNode f) m) (reverseDigit f pr) reverseNode :: (Measured v2 a2) => (a1 -> a2) -> Node v1 a1 -> Node v2 a2 reverseNode f (Node2 _ a b) = node2 (f b) (f a)@@ -801,7 +820,7 @@ illegal_argument :: String -> a illegal_argument name =- error $ "Logic error: " ++ name ++ " called with illegal argument"+ error $ "Logic error: " ++ name ++ " called with illegal argument" {- $example
Data/IntervalMap/FingerTree.hs view
@@ -11,10 +11,10 @@ -- 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>+-- * Ralf Hinze and Ross Paterson,+-- \"Finger trees: a simple general-purpose data structure\",+-- /Journal of Functional Programming/ 16:2 (2006) pp 197-217.+-- <http://staff.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@@ -27,13 +27,13 @@ ----------------------------------------------------------------------------- module Data.IntervalMap.FingerTree (- -- * Intervals- Interval(..), point,- -- * Interval maps- IntervalMap, empty, singleton, insert, union,- -- * Searching- search, intersections, dominators- ) where+ -- * 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(..), (<|), (><))@@ -50,7 +50,7 @@ -- | 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)+ deriving (Eq, Ord, Show) -- | An interval in which the lower and upper bounds are equal. point :: v -> Interval v@@ -59,48 +59,48 @@ data Node v a = Node (Interval v) a instance Functor (Node v) where- fmap f (Node i x) = Node i (f x)+ fmap f (Node i x) = Node i (f x) instance Foldable (Node v) where- foldMap f (Node _ x) = f x+ foldMap f (Node _ x) = f x instance Traversable (Node v) where- traverse f (Node i x) = Node i <$> f x+ 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)+ 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)+ 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))+ 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)+ fmap f (IntervalMap t) = IntervalMap (FT.unsafeFmap (fmap f) t) instance Foldable (IntervalMap v) where- foldMap f (IntervalMap t) = foldMap (foldMap f) t+ foldMap f (IntervalMap t) = foldMap (foldMap f) t instance Traversable (IntervalMap v) where- traverse f (IntervalMap t) =- IntervalMap <$> FT.unsafeTraverse (traverse f) t+ traverse f (IntervalMap t) =+ IntervalMap <$> FT.unsafeTraverse (traverse f) t -- | 'empty' and 'union'. instance (Ord v) => Monoid (IntervalMap v a) where- mempty = empty- mappend = union+ mempty = empty+ mappend = union -- | /O(1)/. The empty interval map. empty :: (Ord v) => IntervalMap v a@@ -114,26 +114,33 @@ -- 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 (Interval lo hi) _ 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+ where+ (l, r) = FT.split larger t+ larger (IntInterval k _) = k >= i+ larger NoInterval = error "larger NoInterval" -- | /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+ 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+ larger NoInterval = error "larger NoInterval"+ 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+ larger NoInterval = error "larger NoInterval" -- | /O(k log (n/\//k))/. All intervals that intersect with the given -- interval, in lexicographical order.@@ -154,39 +161,47 @@ -- 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'+ 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+atleast _ NoInterval = error "atleast NoInterval" greater :: (Ord v) => v -> IntInterval v -> Bool greater k (IntInterval i _) = low i > k+greater _ NoInterval = error "greater NoInterval" +{-+-- Examples+ mkMap :: (Ord v) => [(v, v, a)] -> IntervalMap v a mkMap = foldr ins empty- where ins (lo, hi, n) = insert (Interval lo hi) n+ 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")]+ (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")]+ (1642, 1727, "Newton"),+ (1646, 1716, "Leibniz"),+ (1707, 1783, "Euler"),+ (1736, 1813, "Lagrange"),+ (1777, 1855, "Gauss"),+ (1811, 1831, "Galois")]+-}
Data/PriorityQueue/FingerTree.hs view
@@ -11,10 +11,10 @@ -- 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>+-- * Ralf Hinze and Ross Paterson,+-- \"Finger trees: a simple general-purpose data structure\",+-- /Journal of Functional Programming/ 16:2 (2006) pp 197-217.+-- <http://staff.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.@@ -33,65 +33,63 @@ ----------------------------------------------------------------------------- module Data.PriorityQueue.FingerTree (- PQueue,- -- * Construction- empty,- singleton,- union,- insert,- add,- fromList,- -- * Deconstruction- null,- minView,- minViewWithKey- ) where+ 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 Data.FingerTree (FingerTree, (<|), (|>), (><), ViewL(..), Measured(..)) 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 }+data Entry k v = Entry k v instance Functor (Entry k) where- fmap f (Entry k v) = Entry k (f v)+ fmap f (Entry k v) = Entry k (f v) instance Foldable (Entry k) where- foldMap f (Entry _ v) = f v+ 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+ 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+ 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)+ 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'+ 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+ mempty = empty+ mappend = union -- | /O(1)/. The empty priority queue. empty :: Ord k => PQueue k v@@ -165,10 +163,11 @@ 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+ _ :< 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
fingertree.cabal view
@@ -1,5 +1,5 @@ Name: fingertree-Version: 0.1.0.0+Version: 0.1.0.1 Cabal-Version: >= 1.8 Copyright: (c) 2006 Ross Paterson, Ralf Hinze License: BSD3