| 1 | Sun Jul 12 13:54:29 EDT 2009 wasserman.louis@gmail.com |
|---|
| 2 | * Ticket #3271: New methods for Data.Sequence |
|---|
| 3 | |
|---|
| 4 | New patches: |
|---|
| 5 | |
|---|
| 6 | [Ticket #3271: New methods for Data.Sequence |
|---|
| 7 | wasserman.louis@gmail.com**20090712175429 |
|---|
| 8 | Ignore-this: 86fc65dea4fdb6d2829137b5566d4036 |
|---|
| 9 | ] { |
|---|
| 10 | hunk ./Data/Sequence.hs 39 |
|---|
| 11 | -- * Construction |
|---|
| 12 | empty, -- :: Seq a |
|---|
| 13 | singleton, -- :: a -> Seq a |
|---|
| 14 | + replicate, -- :: Int -> a -> Seq a |
|---|
| 15 | (<|), -- :: a -> Seq a -> Seq a |
|---|
| 16 | (|>), -- :: Seq a -> a -> Seq a |
|---|
| 17 | (><), -- :: Seq a -> Seq a -> Seq a |
|---|
| 18 | hunk ./Data/Sequence.hs 44 |
|---|
| 19 | fromList, -- :: [a] -> Seq a |
|---|
| 20 | + -- ** Sequential construction |
|---|
| 21 | + iterate, -- :: Int -> (a -> a) -> a -> Seq a |
|---|
| 22 | + unfoldr, -- :: (b -> Maybe (a, b)) -> b -> Seq a |
|---|
| 23 | -- * Deconstruction |
|---|
| 24 | -- | Additional functions for deconstructing sequences are available |
|---|
| 25 | -- via the 'Foldable' instance of 'Seq'. |
|---|
| 26 | hunk ./Data/Sequence.hs 59 |
|---|
| 27 | viewl, -- :: Seq a -> ViewL a |
|---|
| 28 | ViewR(..), |
|---|
| 29 | viewr, -- :: Seq a -> ViewR a |
|---|
| 30 | + -- ** Scanning |
|---|
| 31 | + scanl, -- :: (a -> b -> a) -> a -> Seq b -> Seq a |
|---|
| 32 | + scanl1, -- :: (a -> a -> a) -> Seq a -> Seq a |
|---|
| 33 | + scanr, -- :: (a -> b -> b) -> b -> Seq a -> Seq b |
|---|
| 34 | + scanr1, -- :: (a -> a -> a) -> Seq a -> Seq a |
|---|
| 35 | + -- ** Sublists |
|---|
| 36 | + tails, -- :: Seq a -> Seq (Seq a) |
|---|
| 37 | + inits, -- :: Seq a -> Seq (Seq a) |
|---|
| 38 | + takeWhile, -- :: (a -> Bool) -> Seq a -> Seq a |
|---|
| 39 | + dropWhile, -- :: (a -> Bool) -> Seq a -> Seq a |
|---|
| 40 | + span, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |
|---|
| 41 | + break, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |
|---|
| 42 | + partition, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |
|---|
| 43 | + -- ** Sorts |
|---|
| 44 | + sort, -- :: Ord a => Seq a -> Seq a |
|---|
| 45 | + sortBy, -- :: (a -> a -> Ordering) -> Seq a -> Seq a |
|---|
| 46 | -- ** Indexing |
|---|
| 47 | index, -- :: Seq a -> Int -> a |
|---|
| 48 | adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a |
|---|
| 49 | hunk ./Data/Sequence.hs 84 |
|---|
| 50 | splitAt, -- :: Int -> Seq a -> (Seq a, Seq a) |
|---|
| 51 | -- * Transformations |
|---|
| 52 | reverse, -- :: Seq a -> Seq a |
|---|
| 53 | + -- ** Zips |
|---|
| 54 | + zip, -- :: Seq a -> Seq b -> Seq (a, b) |
|---|
| 55 | + zipWith, -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c |
|---|
| 56 | + zip3, -- :: Seq a -> Seq b -> Seq c -> Seq (a, b, c) |
|---|
| 57 | + zipWith3, -- :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d |
|---|
| 58 | + zip4, -- :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d) |
|---|
| 59 | + zipWith4, -- :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e |
|---|
| 60 | #if TESTING |
|---|
| 61 | valid, |
|---|
| 62 | #endif |
|---|
| 63 | hunk ./Data/Sequence.hs 97 |
|---|
| 64 | ) where |
|---|
| 65 | |
|---|
| 66 | import Prelude hiding ( |
|---|
| 67 | - null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, |
|---|
| 68 | - reverse) |
|---|
| 69 | -import qualified Data.List (foldl') |
|---|
| 70 | + null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, span, |
|---|
| 71 | + scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3, |
|---|
| 72 | + takeWhile, dropWhile, break, iterate, reverse) |
|---|
| 73 | +import qualified Data.List (foldl', sortBy) |
|---|
| 74 | import Control.Applicative (Applicative(..), (<$>)) |
|---|
| 75 | import Control.Monad (MonadPlus(..)) |
|---|
| 76 | import Data.Monoid (Monoid(..)) |
|---|
| 77 | hunk ./Data/Sequence.hs 119 |
|---|
| 78 | #endif |
|---|
| 79 | |
|---|
| 80 | #if TESTING |
|---|
| 81 | -import Control.Monad (liftM, liftM3, liftM4) |
|---|
| 82 | +import Control.Monad (liftM, liftM2, liftM3, liftM4) |
|---|
| 83 | import Test.QuickCheck |
|---|
| 84 | #endif |
|---|
| 85 | |
|---|
| 86 | hunk ./Data/Sequence.hs 125 |
|---|
| 87 | infixr 5 `consTree` |
|---|
| 88 | infixl 5 `snocTree` |
|---|
| 89 | +infixr 5 `consDigitToTree` |
|---|
| 90 | +infixl 6 `snocDigitToTree` |
|---|
| 91 | |
|---|
| 92 | infixr 5 >< |
|---|
| 93 | infixr 5 <|, :< |
|---|
| 94 | hunk ./Data/Sequence.hs 279 |
|---|
| 95 | traverse f sf |
|---|
| 96 | |
|---|
| 97 | {-# INLINE deep #-} |
|---|
| 98 | -{-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |
|---|
| 99 | -{-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |
|---|
| 100 | +{-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |
|---|
| 101 | +{-# SPECIALIZE INLINE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |
|---|
| 102 | deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a |
|---|
| 103 | deep pr m sf = Deep (size pr + size m + size sf) pr m sf |
|---|
| 104 | |
|---|
| 105 | hunk ./Data/Sequence.hs 317 |
|---|
| 106 | foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d |
|---|
| 107 | |
|---|
| 108 | instance Functor Digit where |
|---|
| 109 | - fmap = fmapDefault |
|---|
| 110 | + fmap f (One x) = One (f x) |
|---|
| 111 | + fmap f (Two x y) = Two (f x) (f y) |
|---|
| 112 | + fmap f (Three x y z) = Three (f x) (f y) (f z) |
|---|
| 113 | + fmap f (Four x y z w) = Four (f x) (f y) (f z) (f w) |
|---|
| 114 | |
|---|
| 115 | instance Traversable Digit where |
|---|
| 116 | traverse f (One a) = One <$> f a |
|---|
| 117 | hunk ./Data/Sequence.hs 329 |
|---|
| 118 | traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d |
|---|
| 119 | |
|---|
| 120 | instance Sized a => Sized (Digit a) where |
|---|
| 121 | - {-# SPECIALIZE instance Sized (Digit (Elem a)) #-} |
|---|
| 122 | - {-# SPECIALIZE instance Sized (Digit (Node a)) #-} |
|---|
| 123 | - size xs = foldl (\ i x -> i + size x) 0 xs |
|---|
| 124 | + size = sizeDigit |
|---|
| 125 | + |
|---|
| 126 | +{-# SPECIALIZE sizeDigit :: Digit (Elem a) -> Int #-} |
|---|
| 127 | +{-# SPECIALIZE sizeDigit :: Digit (Node a) -> Int #-} |
|---|
| 128 | +sizeDigit :: Sized a => Digit a -> Int |
|---|
| 129 | +sizeDigit (One x) = size x |
|---|
| 130 | +sizeDigit (Two x y) = size x + size y |
|---|
| 131 | +sizeDigit (Three x y z) = size x + size y + size z |
|---|
| 132 | +sizeDigit (Four x y z w) = size x + size y + size z + size w |
|---|
| 133 | |
|---|
| 134 | {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-} |
|---|
| 135 | {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-} |
|---|
| 136 | hunk ./Data/Sequence.hs 364 |
|---|
| 137 | foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c |
|---|
| 138 | |
|---|
| 139 | instance Functor Node where |
|---|
| 140 | - fmap = fmapDefault |
|---|
| 141 | + fmap f (Node2 n a b) = Node2 n (f a) (f b) |
|---|
| 142 | + fmap f (Node3 n a b c) = Node3 n (f a) (f b) (f c) |
|---|
| 143 | |
|---|
| 144 | instance Traversable Node where |
|---|
| 145 | traverse f (Node2 v a b) = Node2 v <$> f a <*> f b |
|---|
| 146 | hunk ./Data/Sequence.hs 425 |
|---|
| 147 | singleton :: a -> Seq a |
|---|
| 148 | singleton x = Seq (Single (Elem x)) |
|---|
| 149 | |
|---|
| 150 | +-- | /O(log n)/. @replicate n x@ is a sequence of length @n@ with @x@ the value of every element. |
|---|
| 151 | +replicate :: Int -> a -> Seq a |
|---|
| 152 | +replicate n _ | n < 0 = error "replicate takes a nonnegative integer argument" |
|---|
| 153 | +replicate n x = Seq (replicateFinger n (Elem x)) |
|---|
| 154 | + |
|---|
| 155 | +{-# SPECIALIZE replicateFinger :: Int -> Elem a -> FingerTree (Elem a) #-} |
|---|
| 156 | +{-# SPECIALIZE replicateFinger :: Int -> Node a -> FingerTree (Node a) #-} |
|---|
| 157 | +replicateFinger :: Sized a => Int -> a -> FingerTree a |
|---|
| 158 | +-- Replicates an element in a FingerTree using /O(log n)/ space with careful use of |
|---|
| 159 | +-- node sharing. The reduction in allocation over @fromList (Prelude.replicate n x)@ |
|---|
| 160 | +-- is tremendous. |
|---|
| 161 | +replicateFinger n x = case n of |
|---|
| 162 | + 0 -> Empty |
|---|
| 163 | + 1 -> Single x |
|---|
| 164 | + 2 -> deep one Empty one |
|---|
| 165 | + 3 -> deep two Empty one |
|---|
| 166 | + 4 -> deep two Empty two |
|---|
| 167 | + 5 -> deep three Empty two |
|---|
| 168 | + 6 -> deep three Empty three |
|---|
| 169 | + 7 -> deep four Empty three |
|---|
| 170 | + 8 -> deep four Empty four |
|---|
| 171 | + _ -> let node = node3 x x x in case (n - 8) `quotRem` 3 of |
|---|
| 172 | + (q, 0) -> deep four (replicateFinger q node) four |
|---|
| 173 | + (q, 1) -> deep three (replicateFinger (q+1) node) three |
|---|
| 174 | + (q, _) -> deep four (replicateFinger (q+1) node) three |
|---|
| 175 | + where one = One x -- Maximize node sharing. |
|---|
| 176 | + two = Two x x |
|---|
| 177 | + three = Three x x x |
|---|
| 178 | + four = Four x x x x |
|---|
| 179 | + |
|---|
| 180 | -- | /O(1)/. Add an element to the left end of a sequence. |
|---|
| 181 | -- Mnemonic: a triangle with the single element at the pointy end. |
|---|
| 182 | (<|) :: a -> Seq a -> Seq a |
|---|
| 183 | hunk ./Data/Sequence.hs 551 |
|---|
| 184 | appendTree1 xs a Empty = |
|---|
| 185 | xs `snocTree` a |
|---|
| 186 | appendTree1 (Single x) a xs = |
|---|
| 187 | - x `consTree` a `consTree` xs |
|---|
| 188 | + Two x a `consDigitToTree` xs |
|---|
| 189 | appendTree1 xs a (Single x) = |
|---|
| 190 | hunk ./Data/Sequence.hs 553 |
|---|
| 191 | - xs `snocTree` a `snocTree` x |
|---|
| 192 | + xs `snocDigitToTree` Two a x |
|---|
| 193 | appendTree1 (Deep s1 pr1 m1 sf1) a (Deep s2 pr2 m2 sf2) = |
|---|
| 194 | Deep (s1 + size a + s2) pr1 (addDigits1 m1 sf1 a pr2 m2) sf2 |
|---|
| 195 | |
|---|
| 196 | hunk ./Data/Sequence.hs 593 |
|---|
| 197 | |
|---|
| 198 | appendTree2 :: FingerTree (Node a) -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) |
|---|
| 199 | appendTree2 Empty a b xs = |
|---|
| 200 | - a `consTree` b `consTree` xs |
|---|
| 201 | + Two a b `consDigitToTree` xs |
|---|
| 202 | appendTree2 xs a b Empty = |
|---|
| 203 | hunk ./Data/Sequence.hs 595 |
|---|
| 204 | - xs `snocTree` a `snocTree` b |
|---|
| 205 | + xs `snocDigitToTree` Two a b |
|---|
| 206 | appendTree2 (Single x) a b xs = |
|---|
| 207 | hunk ./Data/Sequence.hs 597 |
|---|
| 208 | - x `consTree` a `consTree` b `consTree` xs |
|---|
| 209 | + Three x a b `consDigitToTree` xs |
|---|
| 210 | appendTree2 xs a b (Single x) = |
|---|
| 211 | hunk ./Data/Sequence.hs 599 |
|---|
| 212 | - xs `snocTree` a `snocTree` b `snocTree` x |
|---|
| 213 | + xs `snocDigitToTree` Three a b x |
|---|
| 214 | appendTree2 (Deep s1 pr1 m1 sf1) a b (Deep s2 pr2 m2 sf2) = |
|---|
| 215 | Deep (s1 + size a + size b + s2) pr1 (addDigits2 m1 sf1 a b pr2 m2) sf2 |
|---|
| 216 | |
|---|
| 217 | hunk ./Data/Sequence.hs 639 |
|---|
| 218 | |
|---|
| 219 | appendTree3 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) |
|---|
| 220 | appendTree3 Empty a b c xs = |
|---|
| 221 | - a `consTree` b `consTree` c `consTree` xs |
|---|
| 222 | + Three a b c `consDigitToTree` xs |
|---|
| 223 | appendTree3 xs a b c Empty = |
|---|
| 224 | hunk ./Data/Sequence.hs 641 |
|---|
| 225 | - xs `snocTree` a `snocTree` b `snocTree` c |
|---|
| 226 | + xs `snocDigitToTree` Three a b c |
|---|
| 227 | appendTree3 (Single x) a b c xs = |
|---|
| 228 | hunk ./Data/Sequence.hs 643 |
|---|
| 229 | - x `consTree` a `consTree` b `consTree` c `consTree` xs |
|---|
| 230 | + Four x a b c `consDigitToTree` xs |
|---|
| 231 | appendTree3 xs a b c (Single x) = |
|---|
| 232 | hunk ./Data/Sequence.hs 645 |
|---|
| 233 | - xs `snocTree` a `snocTree` b `snocTree` c `snocTree` x |
|---|
| 234 | + xs `snocDigitToTree` Four a b c x |
|---|
| 235 | appendTree3 (Deep s1 pr1 m1 sf1) a b c (Deep s2 pr2 m2 sf2) = |
|---|
| 236 | Deep (s1 + size a + size b + size c + s2) pr1 (addDigits3 m1 sf1 a b c pr2 m2) sf2 |
|---|
| 237 | |
|---|
| 238 | hunk ./Data/Sequence.hs 685 |
|---|
| 239 | |
|---|
| 240 | appendTree4 :: FingerTree (Node a) -> Node a -> Node a -> Node a -> Node a -> FingerTree (Node a) -> FingerTree (Node a) |
|---|
| 241 | appendTree4 Empty a b c d xs = |
|---|
| 242 | - a `consTree` b `consTree` c `consTree` d `consTree` xs |
|---|
| 243 | + Four a b c d `consDigitToTree` xs |
|---|
| 244 | appendTree4 xs a b c d Empty = |
|---|
| 245 | hunk ./Data/Sequence.hs 687 |
|---|
| 246 | - xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d |
|---|
| 247 | + xs `snocDigitToTree` Four a b c d |
|---|
| 248 | appendTree4 (Single x) a b c d xs = |
|---|
| 249 | hunk ./Data/Sequence.hs 689 |
|---|
| 250 | - x `consTree` a `consTree` b `consTree` c `consTree` d `consTree` xs |
|---|
| 251 | + x `consTree` Four a b c d `consDigitToTree` xs |
|---|
| 252 | appendTree4 xs a b c d (Single x) = |
|---|
| 253 | hunk ./Data/Sequence.hs 691 |
|---|
| 254 | - xs `snocTree` a `snocTree` b `snocTree` c `snocTree` d `snocTree` x |
|---|
| 255 | + xs `snocDigitToTree` Four a b c d `snocTree` x |
|---|
| 256 | appendTree4 (Deep s1 pr1 m1 sf1) a b c d (Deep s2 pr2 m2 sf2) = |
|---|
| 257 | Deep (s1 + size a + size b + size c + size d + s2) pr1 (addDigits4 m1 sf1 a b c d pr2 m2) sf2 |
|---|
| 258 | |
|---|
| 259 | hunk ./Data/Sequence.hs 729 |
|---|
| 260 | addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 = |
|---|
| 261 | appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2 |
|---|
| 262 | |
|---|
| 263 | +-- Cons and snoc for entire digits at once. This code was automatically generated. |
|---|
| 264 | +-- For general internal use, this is considerably more efficient than repeated use of |
|---|
| 265 | +-- consTree or snocTree, which end up case'ing the appropriate digit once for every |
|---|
| 266 | +-- insertion, while this code only does it once. |
|---|
| 267 | + |
|---|
| 268 | +{-# SPECIALIZE consDigitToTree :: Digit (Elem a) -> FingerTree (Elem a) -> FingerTree (Elem a) #-} |
|---|
| 269 | +{-# SPECIALIZE consDigitToTree :: Digit (Node a) -> FingerTree (Node a) -> FingerTree (Node a) #-} |
|---|
| 270 | +consDigitToTree :: Sized a => Digit a -> FingerTree a -> FingerTree a |
|---|
| 271 | +consDigitToTree dig Empty |
|---|
| 272 | + = digitToTree dig |
|---|
| 273 | +consDigitToTree dig (Single a) |
|---|
| 274 | + = Deep (size dig + size a) dig Empty (One a) |
|---|
| 275 | +consDigitToTree dig@(One a) (Deep n (One x) m sf) |
|---|
| 276 | + = Deep (n + size dig) (Two a x) m sf |
|---|
| 277 | +consDigitToTree dig@(One a) (Deep n (Two x y) m sf) |
|---|
| 278 | + = Deep (n + size dig) (Three a x y) m sf |
|---|
| 279 | +consDigitToTree dig@(One a) (Deep n (Three x y z) m sf) |
|---|
| 280 | + = Deep (n + size dig) (Four a x y z) m sf |
|---|
| 281 | +consDigitToTree dig@(One a) (Deep n (Four x y z w) m sf) |
|---|
| 282 | + = Deep (n + size dig) (Two a x) ((node3 y z w) `consTree` m) sf |
|---|
| 283 | +consDigitToTree dig@(Two a b) (Deep n (One x) m sf) |
|---|
| 284 | + = Deep (n + size dig) (Three a b x) m sf |
|---|
| 285 | +consDigitToTree dig@(Two a b) (Deep n (Two x y) m sf) |
|---|
| 286 | + = Deep (n + size dig) (Four a b x y) m sf |
|---|
| 287 | +consDigitToTree dig@(Two a b) (Deep n (Three x y z) m sf) |
|---|
| 288 | + = Deep (n + size dig) (Two a b) ((node3 x y z) `consTree` m) sf |
|---|
| 289 | +consDigitToTree dig@(Two a b) (Deep n (Four x y z w) m sf) |
|---|
| 290 | + = Deep (n + size dig) (Three a b x) ((node3 y z w) `consTree` m) sf |
|---|
| 291 | +consDigitToTree dig@(Three a b c) (Deep n (One x) m sf) |
|---|
| 292 | + = Deep (n + size dig) (Four a b c x) m sf |
|---|
| 293 | +consDigitToTree dig@(Three a b c) (Deep n (Two x y) m sf) |
|---|
| 294 | + = Deep (n + size dig) (Two a b) ((node3 c x y) `consTree` m) sf |
|---|
| 295 | +consDigitToTree dig@(Three a b c) (Deep n (Three x y z) m sf) |
|---|
| 296 | + = Deep (n + size dig) (Three a b c) ((node3 x y z) `consTree` m) sf |
|---|
| 297 | +consDigitToTree dig@(Three a b c) (Deep n (Four x y z w) m sf) |
|---|
| 298 | + = Deep (n + size dig) (One a) (Two (node3 b c x) (node3 y z w) `consDigitToTree` m) sf |
|---|
| 299 | +consDigitToTree dig@(Four a b c d) (Deep n (One x) m sf) |
|---|
| 300 | + = Deep (n + size dig) (Two a b) ((node3 c d x) `consTree` m) sf |
|---|
| 301 | +consDigitToTree dig@(Four a b c d) (Deep n (Two x y) m sf) |
|---|
| 302 | + = Deep (n + size dig) (Three a b c) ((node3 d x y) `consTree` m) sf |
|---|
| 303 | +consDigitToTree dig@(Four a b c d) (Deep n (Three x y z) m sf) |
|---|
| 304 | + = Deep (n + size dig) (One a) (Two (node3 b c d) (node3 x y z) `consDigitToTree` m) sf |
|---|
| 305 | +consDigitToTree dig@(Four a b c d) (Deep n (Four x y z w) m sf) |
|---|
| 306 | + = Deep (n + size dig) (Two a b) (Two (node3 c d x) (node3 y z w) `consDigitToTree` m) sf |
|---|
| 307 | + |
|---|
| 308 | +{-# SPECIALIZE snocDigitToTree :: FingerTree (Elem a) -> Digit (Elem a) -> FingerTree (Elem a) #-} |
|---|
| 309 | +{-# SPECIALIZE snocDigitToTree :: FingerTree (Node a) -> Digit (Node a) -> FingerTree (Node a) #-} |
|---|
| 310 | +snocDigitToTree :: Sized a => FingerTree a -> Digit a -> FingerTree a |
|---|
| 311 | +snocDigitToTree Empty dig |
|---|
| 312 | + = digitToTree dig |
|---|
| 313 | +snocDigitToTree (Single a) dig |
|---|
| 314 | + = Deep (size a + size dig) (One a) Empty dig |
|---|
| 315 | +snocDigitToTree (Deep n pr m (One a)) dig@(One x) |
|---|
| 316 | + = Deep (n + size dig) pr m (Two a x) |
|---|
| 317 | +snocDigitToTree (Deep n pr m (One a)) dig@(Two x y) |
|---|
| 318 | + = Deep (n + size dig) pr m (Three a x y) |
|---|
| 319 | +snocDigitToTree (Deep n pr m (One a)) dig@(Three x y z) |
|---|
| 320 | + = Deep (n + size dig) pr m (Four a x y z) |
|---|
| 321 | +snocDigitToTree (Deep n pr m (One a)) dig@(Four x y z w) |
|---|
| 322 | + = Deep (n + size dig) pr (m `snocTree` (node3 a x y)) (Two z w) |
|---|
| 323 | +snocDigitToTree (Deep n pr m (Two a b)) dig@(One x) |
|---|
| 324 | + = Deep (n + size dig) pr m (Three a b x) |
|---|
| 325 | +snocDigitToTree (Deep n pr m (Two a b)) dig@(Two x y) |
|---|
| 326 | + = Deep (n + size dig) pr m (Four a b x y) |
|---|
| 327 | +snocDigitToTree (Deep n pr m (Two a b)) dig@(Three x y z) |
|---|
| 328 | + = Deep (n + size dig) pr (m `snocTree` (node3 a b x)) (Two y z) |
|---|
| 329 | +snocDigitToTree (Deep n pr m (Two a b)) dig@(Four x y z w) |
|---|
| 330 | + = Deep (n + size dig) pr (m `snocTree` (node3 a b x)) (Three y z w) |
|---|
| 331 | +snocDigitToTree (Deep n pr m (Three a b c)) dig@(One x) |
|---|
| 332 | + = Deep (n + size dig) pr m (Four a b c x) |
|---|
| 333 | +snocDigitToTree (Deep n pr m (Three a b c)) dig@(Two x y) |
|---|
| 334 | + = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Two x y) |
|---|
| 335 | +snocDigitToTree (Deep n pr m (Three a b c)) dig@(Three x y z) |
|---|
| 336 | + = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Three x y z) |
|---|
| 337 | +snocDigitToTree (Deep n pr m (Three a b c)) dig@(Four x y z w) |
|---|
| 338 | + = Deep (n + size dig) pr (m `snocDigitToTree` Two (node3 a b c) (node3 x y z)) (One w) |
|---|
| 339 | +snocDigitToTree (Deep n pr m (Four a b c d)) dig@(One x) |
|---|
| 340 | + = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Two d x) |
|---|
| 341 | +snocDigitToTree (Deep n pr m (Four a b c d)) dig@(Two x y) |
|---|
| 342 | + = Deep (n + size dig) pr (m `snocTree` (node3 a b c)) (Three d x y) |
|---|
| 343 | +snocDigitToTree (Deep n pr m (Four a b c d)) dig@(Three x y z) |
|---|
| 344 | + = Deep (n + size dig) pr (m `snocDigitToTree` Two (node3 a b c) (node3 d x y)) (One z) |
|---|
| 345 | +snocDigitToTree (Deep n pr m (Four a b c d)) dig@(Four x y z w) |
|---|
| 346 | + = Deep (n + size dig) pr (m `snocDigitToTree` Two (node3 a b c) (node3 d x y)) (Two z w) |
|---|
| 347 | + |
|---|
| 348 | +-- | Builds a sequence from a seed value. Takes time linear in the number of generated elements. /WARNING: If the number of generated elements is infinite, this method will not terminate./ |
|---|
| 349 | +unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a |
|---|
| 350 | +unfoldr f b = unfoldr' empty b where |
|---|
| 351 | + -- uses tail recursion rather than, for instance, the List implementation. |
|---|
| 352 | + unfoldr' as b = case f b of |
|---|
| 353 | + Nothing -> as |
|---|
| 354 | + Just (a, b') -> unfoldr' (as |> a) b' |
|---|
| 355 | + |
|---|
| 356 | +-- | /O(n)/. Constructs a sequence by repeated application of a function to a seed value. |
|---|
| 357 | +-- |
|---|
| 358 | +-- > iterate n f x = fromList (Prelude.take n (Prelude.iterate f x)) |
|---|
| 359 | +iterate :: Int -> (a -> a) -> a -> Seq a |
|---|
| 360 | +-- borrows the structure of the sequence from replicate and preserves it with mapAccumL |
|---|
| 361 | +iterate n f x = n `seq` snd (mapAccumL iterate' x (replicate n ())) where |
|---|
| 362 | + iterate' y _ = (f y, y) |
|---|
| 363 | + |
|---|
| 364 | ------------------------------------------------------------------------ |
|---|
| 365 | -- Deconstruction |
|---|
| 366 | ------------------------------------------------------------------------ |
|---|
| 367 | hunk ./Data/Sequence.hs 964 |
|---|
| 368 | viewRTree (Deep s pr m (Four w x y z)) = |
|---|
| 369 | Just2 (Deep (s - size z) pr m (Three w x y)) z |
|---|
| 370 | |
|---|
| 371 | +------------------------------------------------------------------------ |
|---|
| 372 | +-- Scans |
|---|
| 373 | +-- |
|---|
| 374 | +-- These are not particularly complex applications of the Traversable |
|---|
| 375 | +-- functor, though making the correspondence with Data.List exact |
|---|
| 376 | +-- requires the use of (<|) and (|>). |
|---|
| 377 | +-- |
|---|
| 378 | +-- Note that save for the single (<|) or (|>), we maintain the original |
|---|
| 379 | +-- structure of the Seq, not having to do any restructuring of our own. |
|---|
| 380 | +-- |
|---|
| 381 | +-- wasserman.louis@gmail.com, 5/23/09 |
|---|
| 382 | +------------------------------------------------------------------------ |
|---|
| 383 | + |
|---|
| 384 | +-- | 'scanl' is similar to 'foldl', but returns a sequence of reduced values from the left: |
|---|
| 385 | +-- |
|---|
| 386 | +-- > scanl f z (fromList [x1, x2, ...]) = fromList [z, z `f` x1, (z `f` x1) `f` x2, ...] |
|---|
| 387 | +scanl :: (a -> b -> a) -> a -> Seq b -> Seq a |
|---|
| 388 | +scanl f z0 xs = z0 <| snd (mapAccumL accum z0 xs) |
|---|
| 389 | + where accum x z = let x' = f x z in (x', x') |
|---|
| 390 | + |
|---|
| 391 | +-- | 'scanl1' is a variant of 'scanl' that has no starting value argument: |
|---|
| 392 | +-- |
|---|
| 393 | +-- > scanl1 f (fromList [x1, x2, ...]) = fromList [x1, x1 `f` x2, ...] |
|---|
| 394 | +scanl1 :: (a -> a -> a) -> Seq a -> Seq a |
|---|
| 395 | +scanl1 f xs = case viewl xs of |
|---|
| 396 | + EmptyL -> error "scanl1 takes a nonempty sequence as an argument" |
|---|
| 397 | + x :< xs' -> scanl f x xs' |
|---|
| 398 | + |
|---|
| 399 | +-- | 'scanr' is the right-to-left dual of 'scanl'. |
|---|
| 400 | +scanr :: (a -> b -> b) -> b -> Seq a -> Seq b |
|---|
| 401 | +scanr f z0 xs = snd (mapAccumR accum z0 xs) |> z0 |
|---|
| 402 | + where accum z x = let z' = f x z in (z', z') |
|---|
| 403 | + |
|---|
| 404 | +-- | 'scanr1' is a variant of 'scanr' that has no starting value argument. |
|---|
| 405 | +scanr1 :: (a -> a -> a) -> Seq a -> Seq a |
|---|
| 406 | +scanr1 f xs = case viewr xs of |
|---|
| 407 | + EmptyR -> error "scanr1 takes a nonempty sequence as an argument" |
|---|
| 408 | + xs' :> x -> scanr f x xs' |
|---|
| 409 | + |
|---|
| 410 | -- Indexing |
|---|
| 411 | |
|---|
| 412 | -- | /O(log(min(i,n-i)))/. The element at the specified position, |
|---|
| 413 | hunk ./Data/Sequence.hs 1153 |
|---|
| 414 | splitAt i (Seq xs) = (Seq l, Seq r) |
|---|
| 415 | where (l, r) = split i xs |
|---|
| 416 | |
|---|
| 417 | +-- | /O(n)/. Returns a sequence of all suffixes of this sequence, longest first. For example, |
|---|
| 418 | +-- |
|---|
| 419 | +-- > tails (fromList "abc") = fromList [fromList "abc", fromList "bc", fromList "c", fromList ""] |
|---|
| 420 | +-- |
|---|
| 421 | +-- The suffixes are computed lazily from left to right. |
|---|
| 422 | +tails :: Seq a -> Seq (Seq a) |
|---|
| 423 | +-- Observation: If one value every n/log n values were computed with an application of drop to the original sequence, |
|---|
| 424 | +-- and the remaining values were computed from these, viewing any individual tail would cost O(log n) and viewing every tail |
|---|
| 425 | +-- would cost O(n). This is probably an overcomplication, though. |
|---|
| 426 | +tails xs = scanl tail' xs xs where |
|---|
| 427 | + tail' ys _ = case viewl ys of |
|---|
| 428 | + _ :< ys' -> ys' |
|---|
| 429 | + _ -> error "Invariant failure in Data.Sequence.tails" -- should never happen |
|---|
| 430 | + |
|---|
| 431 | +-- | /O(n)/. Returns a sequence of all prefixes of this sequence, shortest first. For example, |
|---|
| 432 | +-- |
|---|
| 433 | +-- > inits (fromList "abc") = fromList [fromList "", fromList "a", fromList "ab", fromList "abc"] |
|---|
| 434 | +-- |
|---|
| 435 | +-- The prefixes are computed lazily from left to right. |
|---|
| 436 | +inits :: Seq a -> Seq (Seq a) |
|---|
| 437 | +inits = scanl (|>) empty |
|---|
| 438 | + |
|---|
| 439 | split :: Int -> FingerTree (Elem a) -> |
|---|
| 440 | (FingerTree (Elem a), FingerTree (Elem a)) |
|---|
| 441 | split i Empty = i `seq` (Empty, Empty) |
|---|
| 442 | hunk ./Data/Sequence.hs 1205 |
|---|
| 443 | spm = spr + size m |
|---|
| 444 | im = i - spr |
|---|
| 445 | |
|---|
| 446 | +{-# SPECIALIZE pullL :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> FingerTree (Elem a) #-} |
|---|
| 447 | +{-# SPECIALIZE pullL :: Digit (Node a) -> FingerTree (Node (Node a)) -> FingerTree (Node a) #-} |
|---|
| 448 | +pullL :: Sized a => Digit a -> FingerTree (Node a) -> FingerTree a |
|---|
| 449 | +pullL pr m = case viewRTree m of |
|---|
| 450 | + Nothing2 -> digitToTree pr |
|---|
| 451 | + Just2 m' sf -> Deep (size pr + size m) pr m' (nodeToDigit sf) |
|---|
| 452 | + |
|---|
| 453 | +{-# SPECIALIZE pullR :: FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |
|---|
| 454 | +{-# SPECIALIZE pullR :: FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |
|---|
| 455 | +pullR :: Sized a => FingerTree (Node a) -> Digit a -> FingerTree a |
|---|
| 456 | +pullR m sf = case viewLTree m of |
|---|
| 457 | + Nothing2 -> digitToTree sf |
|---|
| 458 | + Just2 pr m' -> Deep (size sf + size m) (nodeToDigit pr) m' sf |
|---|
| 459 | + |
|---|
| 460 | +{-# SPECIALIZE pull :: FingerTree (Node (Elem a)) -> FingerTree (Elem a) #-} |
|---|
| 461 | +{-# SPECIALIZE pull :: FingerTree (Node (Node a)) -> FingerTree (Node a) #-} |
|---|
| 462 | +-- Pulls a left and a right digit out of a deep finger tree to make a new tree. pull t == deepLR Nothing t Nothing. |
|---|
| 463 | +pull :: Sized a => FingerTree (Node a) -> FingerTree a |
|---|
| 464 | +pull t = case viewLTree t of |
|---|
| 465 | + Nothing2 -> Empty |
|---|
| 466 | + Just2 pr t' -> pullL (nodeToDigit pr) t' |
|---|
| 467 | + |
|---|
| 468 | {-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |
|---|
| 469 | {-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |
|---|
| 470 | deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a |
|---|
| 471 | hunk ./Data/Sequence.hs 1230 |
|---|
| 472 | -deepL Nothing m sf = case viewLTree m of |
|---|
| 473 | - Nothing2 -> digitToTree sf |
|---|
| 474 | - Just2 a m' -> Deep (size m + size sf) (nodeToDigit a) m' sf |
|---|
| 475 | +deepL Nothing m sf = pullR m sf |
|---|
| 476 | deepL (Just pr) m sf = deep pr m sf |
|---|
| 477 | |
|---|
| 478 | {-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-} |
|---|
| 479 | hunk ./Data/Sequence.hs 1236 |
|---|
| 480 | {-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-} |
|---|
| 481 | deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a |
|---|
| 482 | -deepR pr m Nothing = case viewRTree m of |
|---|
| 483 | - Nothing2 -> digitToTree pr |
|---|
| 484 | - Just2 m' a -> Deep (size pr + size m) pr m' (nodeToDigit a) |
|---|
| 485 | +deepR pr m Nothing = pullL pr m |
|---|
| 486 | deepR pr m (Just sf) = deep pr m sf |
|---|
| 487 | |
|---|
| 488 | hunk ./Data/Sequence.hs 1239 |
|---|
| 489 | +{-# SPECIALIZE INLINE deepLR :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-} |
|---|
| 490 | +{-# SPECIALIZE INLINE deepLR :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-} |
|---|
| 491 | +deepLR :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a |
|---|
| 492 | +deepLR (Just pr) m Nothing = pullL pr m |
|---|
| 493 | +deepLR (Just pr) m (Just sf) = deep pr m sf |
|---|
| 494 | +deepLR Nothing m (Just sf) = pullR m sf |
|---|
| 495 | +deepLR Nothing m Nothing = pull m |
|---|
| 496 | + |
|---|
| 497 | {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-} |
|---|
| 498 | {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-} |
|---|
| 499 | splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a |
|---|
| 500 | hunk ./Data/Sequence.hs 1284 |
|---|
| 501 | sab = sa + size b |
|---|
| 502 | sabc = sab + size c |
|---|
| 503 | |
|---|
| 504 | +-- | /O(i)/ where /i/ is the breakpoint index. 'takeWhile', applied to a predicate @p@ and a sequence @xs@, returns the longest prefix (possibly empty) of @xs@ of elements that satisfy @p@. |
|---|
| 505 | +takeWhile :: (a -> Bool) -> Seq a -> Seq a |
|---|
| 506 | +takeWhile p xs = fst (span p xs) |
|---|
| 507 | + |
|---|
| 508 | +-- | /O(i)/ where /i/ is the breakpoint index. @'dropWhile' p xs@ returns the suffix remaining after @takeWhile p xs@. |
|---|
| 509 | +dropWhile :: (a -> Bool) -> Seq a -> Seq a |
|---|
| 510 | +dropWhile p xs = snd (span p xs) |
|---|
| 511 | + |
|---|
| 512 | +-- | /O(i)/ where /i/ is the breakpoint index. 'span', applied to a predicate @p@ and a sequence @xs@, returns a tuple whose first element is the longest prefix (possibly empty) of @xs@ of elements that satisfy @p@ and the second element is the remainder of the sequence. |
|---|
| 513 | +span :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |
|---|
| 514 | +span p xs = splitAt ix xs |
|---|
| 515 | + where indexed = snd (mapAccumL (\ i x -> i `seq` (i + 1, (x, i))) 0 xs) |
|---|
| 516 | + ix = foldr (\ (x, i) i' -> if p x then i' else i) (length xs) indexed |
|---|
| 517 | + |
|---|
| 518 | +-- | /O(i)/ where /i/ is the breakpoint index. 'break', applied to a predicate @p@ and a sequence @xs@, returns a tuple whose first element is the longest prefix (possibly empty) of @xs@ of elements that /do not satisfy/ @p@ and the second element is the remainder of the sequence. |
|---|
| 519 | +break :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |
|---|
| 520 | +break p xs = span (not . p) xs |
|---|
| 521 | + |
|---|
| 522 | +-- | /O(n)/. The 'partition' function takes a predicate @p@ and a sequence @xs@ and returns sequences of those elements which do and do not satisfy the predicate. |
|---|
| 523 | +partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |
|---|
| 524 | +partition p (Seq xs) = case partitionTree (\ (Elem x) -> p x) xs of |
|---|
| 525 | + (xsT, xsF) -> (Seq xsT, Seq xsF) |
|---|
| 526 | + |
|---|
| 527 | +{-# SPECIALIZE partitionTree :: (Elem a -> Bool) -> FingerTree (Elem a) -> (FingerTree (Elem a), FingerTree (Elem a)) #-} |
|---|
| 528 | +partitionTree :: Sized a => (a -> Bool) -> FingerTree a -> (FingerTree a, FingerTree a) |
|---|
| 529 | +partitionTree _ Empty = (Empty, Empty) |
|---|
| 530 | +partitionTree p (Single x) |
|---|
| 531 | + | p x = (Single x, Empty) |
|---|
| 532 | + | otherwise = (Empty, Single x) |
|---|
| 533 | +partitionTree p (Deep _ pr m sf) = case (partitionDigit p pr, partitionDigit p sf, partitionTree p (pull m)) of |
|---|
| 534 | + ((prT, prF), (sfT, sfF), (mT, mF)) -> (combine prT mT sfT, combine prF mF sfF) |
|---|
| 535 | + where combineL pr m = foldr consDigitToTree m pr -- Golly gee, possibly consing a Maybe value onto a tree |
|---|
| 536 | + combineR m sf = foldl snocDigitToTree m sf -- is a fold! Whoaaaaa! |
|---|
| 537 | + combine pr m sf = pr `combineL` m `combineR` sf |
|---|
| 538 | + |
|---|
| 539 | +partitionDigit :: (a -> Bool) -> Digit a -> (Maybe (Digit a), Maybe (Digit a)) |
|---|
| 540 | +partitionDigit p (One a) = case (p a) of |
|---|
| 541 | + (False) -> (Nothing, Just (One a)) |
|---|
| 542 | + (True) -> (Just (One a), Nothing) |
|---|
| 543 | +partitionDigit p (Two a b) = case (p a, p b) of |
|---|
| 544 | + (False, False) -> (Nothing, Just (Two a b)) |
|---|
| 545 | + (False, True) -> (Just (One b), Just (One a)) |
|---|
| 546 | + (True, False) -> (Just (One a), Just (One b)) |
|---|
| 547 | + (True, True) -> (Just (Two a b), Nothing) |
|---|
| 548 | +partitionDigit p (Three a b c) = case (p a, p b, p c) of |
|---|
| 549 | + (False, False, False) -> (Nothing, Just (Three a b c)) |
|---|
| 550 | + (False, False, True) -> (Just (One c), Just (Two a b)) |
|---|
| 551 | + (False, True, False) -> (Just (One b), Just (Two a c)) |
|---|
| 552 | + (False, True, True) -> (Just (Two b c), Just (One a)) |
|---|
| 553 | + (True, False, False) -> (Just (One a), Just (Two b c)) |
|---|
| 554 | + (True, False, True) -> (Just (Two a c), Just (One b)) |
|---|
| 555 | + (True, True, False) -> (Just (Two a b), Just (One c)) |
|---|
| 556 | + (True, True, True) -> (Just (Three a b c), Nothing) |
|---|
| 557 | +partitionDigit p (Four a b c d) = case (p a, p b, p c, p d) of |
|---|
| 558 | + (False, False, False, False) -> (Nothing, Just (Four a b c d)) |
|---|
| 559 | + (False, False, False, True) -> (Just (One d), Just (Three a b c)) |
|---|
| 560 | + (False, False, True, False) -> (Just (One c), Just (Three a b d)) |
|---|
| 561 | + (False, False, True, True) -> (Just (Two c d), Just (Two a b)) |
|---|
| 562 | + (False, True, False, False) -> (Just (One b), Just (Three a c d)) |
|---|
| 563 | + (False, True, False, True) -> (Just (Two b d), Just (Two a c)) |
|---|
| 564 | + (False, True, True, False) -> (Just (Two b c), Just (Two a d)) |
|---|
| 565 | + (False, True, True, True) -> (Just (Three b c d), Just (One a)) |
|---|
| 566 | + (True, False, False, False) -> (Just (One a), Just (Three b c d)) |
|---|
| 567 | + (True, False, False, True) -> (Just (Two a d), Just (Two b c)) |
|---|
| 568 | + (True, False, True, False) -> (Just (Two a c), Just (Two b d)) |
|---|
| 569 | + (True, False, True, True) -> (Just (Three a c d), Just (One b)) |
|---|
| 570 | + (True, True, False, False) -> (Just (Two a b), Just (Two c d)) |
|---|
| 571 | + (True, True, False, True) -> (Just (Three a b d), Just (One c)) |
|---|
| 572 | + (True, True, True, False) -> (Just (Three a b c), Just (One d)) |
|---|
| 573 | + (True, True, True, True) -> (Just (Four a b c d), Nothing) |
|---|
| 574 | + |
|---|
| 575 | ------------------------------------------------------------------------ |
|---|
| 576 | -- Lists |
|---|
| 577 | ------------------------------------------------------------------------ |
|---|
| 578 | hunk ./Data/Sequence.hs 1381 |
|---|
| 579 | (reverseTree (reverseNode f) m) |
|---|
| 580 | (reverseDigit f pr) |
|---|
| 581 | |
|---|
| 582 | +{-# INLINE reverseDigit #-} |
|---|
| 583 | reverseDigit :: (a -> a) -> Digit a -> Digit a |
|---|
| 584 | reverseDigit f (One a) = One (f a) |
|---|
| 585 | reverseDigit f (Two a b) = Two (f b) (f a) |
|---|
| 586 | hunk ./Data/Sequence.hs 1392 |
|---|
| 587 | reverseNode f (Node2 s a b) = Node2 s (f b) (f a) |
|---|
| 588 | reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a) |
|---|
| 589 | |
|---|
| 590 | +------------------------------------------------------------------------ |
|---|
| 591 | +-- Zipping |
|---|
| 592 | +-- |
|---|
| 593 | +-- We implement zipping on sequences by zipping left and right digits simultaneously and |
|---|
| 594 | +-- processing excess appropriately. This allows several elements to be ``zipped'' |
|---|
| 595 | +-- in a single go, which is significantly faster than it might be for a linked-list approach, |
|---|
| 596 | +-- where we'd have to do at least one dereference for each element. |
|---|
| 597 | +------------------------------------------------------------------------ |
|---|
| 598 | + |
|---|
| 599 | +-- | /O(n)/. 'zip' takes two sequences and returns a sequence of corresponding pairs. |
|---|
| 600 | +-- If one input is short, excess elements of the longer sequence are discarded. |
|---|
| 601 | +zip :: Seq a -> Seq b -> Seq (a, b) |
|---|
| 602 | +zip = zipWith (,) |
|---|
| 603 | + |
|---|
| 604 | +-- | /O(n)/. 'zipWith' generalizes 'zip' by zipping with the function given as the first argument, |
|---|
| 605 | +-- instead of a tupling function. For example, @zipWith (+)@ is applied to two sequences to take |
|---|
| 606 | +-- the sequence of corresponding sums. |
|---|
| 607 | +zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c |
|---|
| 608 | +zipWith f s1 s2 = zipTrunc f (trunc s1) (trunc s2) |
|---|
| 609 | + where n = length s1 `min` length s2 |
|---|
| 610 | + trunc = take n |
|---|
| 611 | + |
|---|
| 612 | +zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) |
|---|
| 613 | +zip3 = zipWith3 (,,) |
|---|
| 614 | + |
|---|
| 615 | +zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d |
|---|
| 616 | +zipWith3 f s1 s2 s3 = zipTrunc ($) (zipTrunc f (trunc s1) (trunc s2)) (trunc s3) |
|---|
| 617 | + where n = length s1 `min` length s2 `min` length s3 |
|---|
| 618 | + trunc = take n |
|---|
| 619 | + |
|---|
| 620 | +zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a,b,c,d) |
|---|
| 621 | +zip4 = zipWith4 (,,,) |
|---|
| 622 | + |
|---|
| 623 | +zipWith4 :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e |
|---|
| 624 | +zipWith4 f s1 s2 s3 s4 = ((zipTrunc f (trunc s1) (trunc s2)) `zipApply` trunc s3) `zipApply` trunc s4 |
|---|
| 625 | + where n = length s1 `min` length s2 `min` length s3 `min` length s4 |
|---|
| 626 | + trunc = take n |
|---|
| 627 | + zipApply = zipTrunc ($) |
|---|
| 628 | + |
|---|
| 629 | +-- assumes its arguments are the same length |
|---|
| 630 | +zipTrunc :: (a -> b -> c) -> Seq a -> Seq b -> Seq c |
|---|
| 631 | +zipTrunc f (Seq a) (Seq b) = Seq (zipWithTree (\ (Elem x) (Elem y) -> Elem (f x y)) a b) |
|---|
| 632 | + |
|---|
| 633 | +{-# NOINLINE zipWithTree #-} |
|---|
| 634 | +-- We maintain as an invariant that t1 and t2 have the same size, guaranteeing that they will always |
|---|
| 635 | +-- have the same FingerTree constructor. We construct the zipped sequence from both sides at once, |
|---|
| 636 | +-- and at each stage "zip" the left and right digits of t1 and t2 and recurse, handling excess appropriately. |
|---|
| 637 | +zipWithTree :: (Elem a -> Elem b -> Elem c) -> FingerTree (Elem a) -> FingerTree (Elem b) -> |
|---|
| 638 | + FingerTree (Elem c) |
|---|
| 639 | +zipWithTree f = zipper where |
|---|
| 640 | + Empty `zipper` Empty = |
|---|
| 641 | + Empty |
|---|
| 642 | + Single a `zipper` Single x = |
|---|
| 643 | + Single (a `f` x) |
|---|
| 644 | + Deep _ l1 m1 r1 `zipper` Deep _ l2 m2 r2 = |
|---|
| 645 | + zipL lZ f l1 l2 where |
|---|
| 646 | + {-# INLINE lZ #-} |
|---|
| 647 | + lZ lZip l1' l2' = zipR rZ f r1 r2 where |
|---|
| 648 | + {-# INLINE rZ #-} |
|---|
| 649 | + rZ rZip r1' r2' = lZip `consDigitToTree` deepLR l1' m1 r1' `zipper` deepLR l2' m2 r2' `snocDigitToTree` rZip |
|---|
| 650 | + |
|---|
| 651 | + _ `zipper` _ = error "Invariant failure in Data.Sequence.zipWith" |
|---|
| 652 | + |
|---|
| 653 | +{-# INLINE zipL #-} |
|---|
| 654 | +-- Zips two digits from the left side, returning the zipped result and remainders. |
|---|
| 655 | +zipL :: (Digit c -> Maybe (Digit a) -> Maybe (Digit b) -> d) -> (a -> b -> c) -> Digit a -> Digit b -> d |
|---|
| 656 | +zipL f (*) (One a) (One x) = f (One (a * x)) (Nothing) (Nothing) |
|---|
| 657 | +zipL f (*) (One a) (Two x y) = f (One (a * x)) (Nothing) (Just (One y)) |
|---|
| 658 | +zipL f (*) (One a) (Three x y z) = f (One (a * x)) (Nothing) (Just (Two y z)) |
|---|
| 659 | +zipL f (*) (One a) (Four x y z w) = f (One (a * x)) (Nothing) (Just (Three y z w)) |
|---|
| 660 | +zipL f (*) (Two a b) (One x) = f (One (a * x)) (Just (One b)) (Nothing) |
|---|
| 661 | +zipL f (*) (Two a b) (Two x y) = f (Two (a * x) (b * y)) (Nothing) (Nothing) |
|---|
| 662 | +zipL f (*) (Two a b) (Three x y z) = f (Two (a * x) (b * y)) (Nothing) (Just (One z)) |
|---|
| 663 | +zipL f (*) (Two a b) (Four x y z w) = f (Two (a * x) (b * y)) (Nothing) (Just (Two z w)) |
|---|
| 664 | +zipL f (*) (Three a b c) (One x) = f (One (a * x)) (Just (Two b c)) (Nothing) |
|---|
| 665 | +zipL f (*) (Three a b c) (Two x y) = f (Two (a * x) (b * y)) (Just (One c)) (Nothing) |
|---|
| 666 | +zipL f (*) (Three a b c) (Three x y z) = f (Three (a * x) (b * y) (c * z)) (Nothing) (Nothing) |
|---|
| 667 | +zipL f (*) (Three a b c) (Four x y z w) = f (Three (a * x) (b * y) (c * z)) (Nothing) (Just (One w)) |
|---|
| 668 | +zipL f (*) (Four a b c d) (One x) = f (One (a * x)) (Just (Three b c d)) (Nothing) |
|---|
| 669 | +zipL f (*) (Four a b c d) (Two x y) = f (Two (a * x) (b * y)) (Just (Two c d)) (Nothing) |
|---|
| 670 | +zipL f (*) (Four a b c d) (Three x y z) = f (Three (a * x) (b * y) (c * z)) (Just (One d)) (Nothing) |
|---|
| 671 | +zipL f (*) (Four a b c d) (Four x y z w)= f (Four (a * x) (b * y) (c * z) (d * w)) (Nothing) (Nothing) |
|---|
| 672 | + |
|---|
| 673 | +-- Zips two digits from the right, returning the zipped result and both remainders. |
|---|
| 674 | +{-# INLINE zipR #-} |
|---|
| 675 | +zipR :: (Digit c -> Maybe (Digit a) -> Maybe (Digit b) -> d) -> (a -> b -> c) -> Digit a -> Digit b -> d |
|---|
| 676 | +zipR f (*) (One a) (One x) = f (One (a * x)) (Nothing) (Nothing) |
|---|
| 677 | +zipR f (*) (One a) (Two x y) = f (One (a * y)) (Nothing) (Just (One x)) |
|---|
| 678 | +zipR f (*) (One a) (Three x y z) = f (One (a * z)) (Nothing) (Just (Two x y)) |
|---|
| 679 | +zipR f (*) (One a) (Four x y z w) = f (One (a * w)) (Nothing) (Just (Three x y z)) |
|---|
| 680 | +zipR f (*) (Two a b) (One x) = f (One (b * x)) (Just (One a)) (Nothing) |
|---|
| 681 | +zipR f (*) (Two a b) (Two x y) = f (Two (a * x) (b * y)) (Nothing) (Nothing) |
|---|
| 682 | +zipR f (*) (Two a b) (Three x y z) = f (Two (a * y) (b * z)) (Nothing) (Just (One x)) |
|---|
| 683 | +zipR f (*) (Two a b) (Four x y z w) = f (Two (a * z) (b * w)) (Nothing) (Just (Two x y)) |
|---|
| 684 | +zipR f (*) (Three a b c) (One x) = f (One (c * x)) (Just (Two a b)) (Nothing) |
|---|
| 685 | +zipR f (*) (Three a b c) (Two x y) = f (Two (b * x) (c * y)) (Just (One a)) (Nothing) |
|---|
| 686 | +zipR f (*) (Three a b c) (Three x y z) = f (Three (a * x) (b * y) (c * z)) (Nothing) (Nothing) |
|---|
| 687 | +zipR f (*) (Three a b c) (Four x y z w) = f (Three (a * y) (b * z) (c * w)) (Nothing) (Just (One x)) |
|---|
| 688 | +zipR f (*) (Four a b c d) (One x) = f (One (d * x)) (Just (Three a b c)) (Nothing) |
|---|
| 689 | +zipR f (*) (Four a b c d) (Two x y) = f (Two (c * x) (d * y)) (Just (Two a b)) (Nothing) |
|---|
| 690 | +zipR f (*) (Four a b c d) (Three x y z) = f (Three (b * x) (c * y) (d * z)) (Just (One a)) (Nothing) |
|---|
| 691 | +zipR f (*) (Four a b c d) (Four x y z w)= f (Four (a * x) (b * y) (c * z) (d * w)) (Nothing) (Nothing) |
|---|
| 692 | + |
|---|
| 693 | + |
|---|
| 694 | +------------------------------------------------------------------------ |
|---|
| 695 | +-- Sorting |
|---|
| 696 | +-- |
|---|
| 697 | +-- Nothing I was able to code was able to beat straight-up conversion from Data.List. |
|---|
| 698 | +-- wasserman.louis@gmail.com, 6/29/09 |
|---|
| 699 | +------------------------------------------------------------------------ |
|---|
| 700 | + |
|---|
| 701 | +-- | /O(n log n)/. Sorts the specified 'Seq' by the default ordering. The sort is stable. |
|---|
| 702 | +sort :: Ord a => Seq a -> Seq a |
|---|
| 703 | +sort = sortBy compare |
|---|
| 704 | + |
|---|
| 705 | +-- | /O(n log n)/. A generalization of 'sort', 'sortBy' takes an arbitrary comparator and sorts the specified sequence. The sort is stable. |
|---|
| 706 | +sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a |
|---|
| 707 | +sortBy cmp = fromList . Data.List.sortBy cmp . toList |
|---|
| 708 | + |
|---|
| 709 | #if TESTING |
|---|
| 710 | |
|---|
| 711 | ------------------------------------------------------------------------ |
|---|
| 712 | } |
|---|
| 713 | |
|---|
| 714 | Context: |
|---|
| 715 | |
|---|
| 716 | [Use left/right rather than old/new to describe the arguments to unionWithKey |
|---|
| 717 | Ian Lynagh <igloo@earth.li>**20090208192132 |
|---|
| 718 | Fixes trac #3002. |
|---|
| 719 | ] |
|---|
| 720 | [help nhc98 by making import decl more explicit |
|---|
| 721 | Malcolm.Wallace@cs.york.ac.uk**20090203142144] |
|---|
| 722 | [Add instance Data.Traversable for IntMap |
|---|
| 723 | Matti Niemenmaa <matti.niemenmaa+darcs@iki.fi>**20090116190353 |
|---|
| 724 | Ignore-this: df88a286935926aecec3f8a5dd291699 |
|---|
| 725 | ] |
|---|
| 726 | [Require Cabal version >= 1.6 |
|---|
| 727 | Ian Lynagh <igloo@earth.li>**20090122011256] |
|---|
| 728 | [Add "bug-reports" and "source-repository" info to the Cabal file |
|---|
| 729 | Ian Lynagh <igloo@earth.li>**20090121182106] |
|---|
| 730 | [Fix warnings in containers |
|---|
| 731 | Ian Lynagh <igloo@earth.li>**20090116200251] |
|---|
| 732 | [optimize IntMap/IntSet findMin/findMax |
|---|
| 733 | sedillard@gmail.com**20081002152055] |
|---|
| 734 | [O(n) fromAscList IntSet / IntMap |
|---|
| 735 | sedillard@gmail.com**20080521195941 |
|---|
| 736 | |
|---|
| 737 | Added algorithm by Scott Dillard and Bertram Felgenhauer to build IntSets and |
|---|
| 738 | IntMaps from sorted input in linear time. Also changed quickcheck prop_Ordered |
|---|
| 739 | (no longer a tautology!) to include negative and duplicate keys. |
|---|
| 740 | |
|---|
| 741 | ] |
|---|
| 742 | [correct type for IntMap.intersectionWith[Key] |
|---|
| 743 | sedillard@gmail.com**20081002144828] |
|---|
| 744 | [Export mapAccumRWithKey from Map and IntMap (Trac #2769) |
|---|
| 745 | matti.niemenmaa+darcs@iki.fi**20081210160205] |
|---|
| 746 | [Bump the version number to 0.2.0.1, to work-around cabal-install problems |
|---|
| 747 | Ian Lynagh <igloo@earth.li>**20081212201829] |
|---|
| 748 | [Fix #2760: change mkNorepType to mkNoRepType |
|---|
| 749 | 'Jose Pedro Magalhaes <jpm@cs.uu.nl>'**20081202083424] |
|---|
| 750 | [Doc fix, from hackage trac #378 |
|---|
| 751 | Ian Lynagh <igloo@earth.li>**20081024143949] |
|---|
| 752 | [import Data.Data instead of Data.Generics.*, eliminating the dependency on syb |
|---|
| 753 | Ross Paterson <ross@soi.city.ac.uk>**20081005002559] |
|---|
| 754 | [fixed typo in highestBitMask |
|---|
| 755 | sedillard@gmail.com**20081002215438] |
|---|
| 756 | [export Data.Map.toDescList, foldlWithKey, and foldrWithKey (trac ticket 2580) |
|---|
| 757 | qdunkan@gmail.com**20080922213200 |
|---|
| 758 | |
|---|
| 759 | toDescList was previously implemented, but not exported. |
|---|
| 760 | |
|---|
| 761 | foldlWithKey was previously implemented, but not exported. It can be used to |
|---|
| 762 | implement toDescList. |
|---|
| 763 | |
|---|
| 764 | foldrWithKey is already exported as foldWithKey, but foldrWithKey is explicitly |
|---|
| 765 | the mirror of foldlWithKey, and foldWithKey kept for compatibility. |
|---|
| 766 | ] |
|---|
| 767 | [Bump version number to 0.2.0.0 |
|---|
| 768 | Ian Lynagh <igloo@earth.li>**20080920160016] |
|---|
| 769 | [TAG 6.10 branch has been forked |
|---|
| 770 | Ian Lynagh <igloo@earth.li>**20080919123438] |
|---|
| 771 | [Fixed typo in updateMinWithKey / updateMaxWithKey |
|---|
| 772 | sedillard@gmail.com**20080704054350] |
|---|
| 773 | [follow library changes |
|---|
| 774 | Ian Lynagh <igloo@earth.li>**20080903223610] |
|---|
| 775 | [add include/Typeable.h to extra-source-files |
|---|
| 776 | Ross Paterson <ross@soi.city.ac.uk>**20080831181402] |
|---|
| 777 | [fix cabal build-depends for nhc98 |
|---|
| 778 | Malcolm.Wallace@cs.york.ac.uk**20080828104248] |
|---|
| 779 | [Add a dep on syb |
|---|
| 780 | Ian Lynagh <igloo@earth.li>**20080825214314] |
|---|
| 781 | [add category field |
|---|
| 782 | Ross Paterson <ross@soi.city.ac.uk>**20080824003013] |
|---|
| 783 | [we depend on st, now split off from base |
|---|
| 784 | Ian Lynagh <igloo@earth.li>**20080823223053] |
|---|
| 785 | [specialize functions that fail in a Monad to Maybe (proposal #2309) |
|---|
| 786 | Ross Paterson <ross@soi.city.ac.uk>**20080722154812 |
|---|
| 787 | |
|---|
| 788 | Specialize functions signatures like |
|---|
| 789 | |
|---|
| 790 | lookup :: (Monad m, Ord k) => k -> Map k a -> m a |
|---|
| 791 | to |
|---|
| 792 | lookup :: (Ord k) => k -> Map k a -> Maybe a |
|---|
| 793 | |
|---|
| 794 | for simplicity and safety. No information is lost, as each of these |
|---|
| 795 | functions had only one use of fail, which is now changed to Nothing. |
|---|
| 796 | ] |
|---|
| 797 | [tighter description of split (addresses #2447) |
|---|
| 798 | Ross Paterson <ross@soi.city.ac.uk>**20080717064838] |
|---|
| 799 | [Make warning-clean with GHC again |
|---|
| 800 | Ian Lynagh <igloo@earth.li>**20080623232023 |
|---|
| 801 | With any luck we have now converged on a solution that works everywhere! |
|---|
| 802 | ] |
|---|
| 803 | [Undo more Data.Typeable-related breakage for non-ghc. |
|---|
| 804 | Malcolm.Wallace@cs.york.ac.uk**20080623092757] |
|---|
| 805 | [Placate GHC with explicit import lists |
|---|
| 806 | Ian Lynagh <igloo@earth.li>**20080620183926] |
|---|
| 807 | [undo breakage caused by -Wall cleaning |
|---|
| 808 | Malcolm.Wallace@cs.york.ac.uk**20080620093922 |
|---|
| 809 | The import of Data.Typeable is still required, at least for non-GHC. |
|---|
| 810 | ] |
|---|
| 811 | [Make the package -Wall clean |
|---|
| 812 | Ian Lynagh <igloo@earth.li>**20080618233627] |
|---|
| 813 | [List particular extensions rather than -fglasgow-exts |
|---|
| 814 | Ian Lynagh <igloo@earth.li>**20080616232035] |
|---|
| 815 | [Avoid using deprecated flags |
|---|
| 816 | Ian Lynagh <igloo@earth.li>**20080616145241] |
|---|
| 817 | [TAG 2008-05-28 |
|---|
| 818 | Ian Lynagh <igloo@earth.li>**20080528004309] |
|---|
| 819 | Patch bundle hash: |
|---|
| 820 | 020f70f7dafefe5af0d3e78a8625c4ace589b3c1 |
|---|