grouped-list (empty) → 0.1.0.0
raw patch · 6 files changed
+513/−0 lines, 6 filesdep +basedep +containersdep +criterionsetup-changed
Dependencies added: base, containers, criterion, deepseq, grouped-list, pointed
Files
- Data/GroupedList.hs +348/−0
- LICENSE +30/−0
- README.md +23/−0
- Setup.hs +2/−0
- bench/Main.hs +61/−0
- grouped-list.cabal +49/−0
+ Data/GroupedList.hs view
@@ -0,0 +1,348 @@++{-# LANGUAGE TupleSections #-}++-- | Grouped lists are like lists, but internally they are represented+-- as groups of consecutive elements.+--+-- For example, the list @[1,2,2,3,4,5,5,5]@ would be internally+-- represented as @[[1],[2,2],[3],[4],[5,5,5]]@.+--+module Data.GroupedList+ ( -- * Type+ Grouped+ -- * Builders+ , point+ , concatMap+ , replicate+ , fromGroup+ -- * Indexing+ , index+ , adjust+ -- * Mapping+ , map+ -- * Traversal+ , traverseGrouped+ , traverseGroupedByGroup+ , traverseGroupedByGroupAccum+ -- * Filtering+ , partition+ , filter+ -- * Sorting+ , sort+ -- * List conversion+ , fromList+ -- * Groups+ , Group+ , buildGroup+ , groupElement+ , groupedGroups+ ) where++import Prelude hiding+ (concat, concatMap, replicate, filter, map)+import qualified Prelude as Prelude+import Data.Pointed+import Data.Foldable (toList, fold, foldrM)+import Data.List (group, foldl')+import Data.Sequence (Seq)+import qualified Data.Sequence as S+import Data.Monoid ((<>))+import Control.DeepSeq (NFData (..))+import Control.Arrow (second)+import qualified Data.Map.Strict as M++------------------------------------------------------------------+------------------------------------------------------------------+-- GROUP++-- | A 'Group' is a non-empty finite list that contains the same element+-- repeated a number of times.+data Group a = Group {-# UNPACK #-} !Int a deriving Eq++-- | Build a group by repeating the given element a number of times.+-- If the given number is less or equal to 0, 'Nothing' is returned.+buildGroup :: Int -> a -> Maybe (Group a)+buildGroup n x = if n <= 0 then Nothing else Just (Group n x)++-- | Get the element of a group.+groupElement :: Group a -> a+groupElement (Group _ a) = a++-- | A group is larger than other if its constituent element is+-- larger. If they are equal, the group with more elements is+-- the larger.+instance Ord a => Ord (Group a) where+ Group n a <= Group m b =+ if a == b+ then n <= m+ else a < b++instance Pointed Group where+ point = Group 1++instance Functor Group where+ fmap f (Group n a) = Group n (f a)++instance Foldable Group where+ foldMap f (Group n a) = mconcat $ Prelude.replicate n $ f a+ elem x (Group _ a) = x == a+ null _ = False+ length (Group n _) = n++instance Show a => Show (Group a) where+ show = show . toList++groupJoin :: Group (Group a) -> Group a+groupJoin (Group n (Group m a)) = Group (n*m) a++groupBind :: Group a -> (a -> Group b) -> Group b+groupBind gx f = groupJoin $ fmap f gx++instance Applicative Group where+ pure = point+ gf <*> gx = groupBind gx $ \x -> fmap ($x) gf++instance Monad Group where+ (>>=) = groupBind++instance NFData a => NFData (Group a) where+ rnf (Group _ a) = rnf a++------------------------------------------------------------------+------------------------------------------------------------------+-- GROUPED++-- | Type of grouped lists. Grouped lists are finite lists that+-- behave well in the abundance of sublists that have all their+-- elements equal.+newtype Grouped a = Grouped (Seq (Group a)) deriving Eq++-- | Build a grouped list from a regular list. It doesn't work if+-- the input list is infinite.+fromList :: Eq a => [a] -> Grouped a+fromList = Grouped . S.fromList . fmap (\g -> Group (length g) $ head g) . group++-- | Build a grouped list from a group (see 'Group').+fromGroup :: Group a -> Grouped a+fromGroup = Grouped . point++-- | Groups of consecutive elements in a grouped list.+groupedGroups :: Grouped a -> [Group a]+groupedGroups (Grouped gs) = toList gs++instance Pointed Grouped where+ point = fromGroup . point++instance Eq a => Monoid (Grouped a) where+ mempty = Grouped S.empty+ mappend (Grouped gs) (Grouped gs') = Grouped $+ case S.viewr gs of+ gsl S.:> Group n l ->+ case S.viewl gs' of+ Group m r S.:< gsr ->+ if l == r+ then gsl S.>< (Group (n+m) l S.<| gsr)+ else gs S.>< gs'+ _ -> gs+ _ -> gs'++-- | Apply a function to every element in a grouped list.+map :: Eq b => (a -> b) -> Grouped a -> Grouped b+map f (Grouped gs) = Grouped $+ case S.viewl gs of+ g S.:< xs ->+ let go (acc, Group n a') (Group m b) =+ let b' = f b+ in if a' == b'+ then (acc, Group (n + m) a')+ else (acc S.|> Group n a', Group m b')+ in (uncurry (S.|>)) $ foldl go (S.empty, fmap f g) xs+ _ -> S.empty++instance Foldable Grouped where+ foldMap f (Grouped gs) = foldMap (foldMap f) gs+ length (Grouped gs) = foldl' (+) 0 $ fmap length gs+ null (Grouped gs) = null gs++instance Show a => Show (Grouped a) where+ show = show . toList++instance NFData a => NFData (Grouped a) where+ rnf (Grouped gs) = rnf gs++------------------------------------------------------------------+------------------------------------------------------------------+-- Monad instance (almost)++-- | Map a function that produces a grouped list for each element+-- in a grouped list, then concat the results.+concatMap :: Eq b => Grouped a -> (a -> Grouped b) -> Grouped b+concatMap gx f = fold $ map f gx++------------------------------------------------------------------+------------------------------------------------------------------+-- Builders++-- | Replicate a single element the given number of times.+-- If the given number is less or equal to zero, it produces+-- an empty list.+replicate :: Int -> a -> Grouped a+replicate n x = Grouped $+ if n <= 0+ then mempty+ else S.singleton $ Group n x++------------------------------------------------------------------+------------------------------------------------------------------+-- Sorting++-- | Sort a grouped list.+sort :: Ord a => Grouped a -> Grouped a+sort (Grouped xs) = Grouped $ S.fromList $ fmap (uncurry $ flip Group)+ $ M.toAscList $ foldr go M.empty xs+ where+ f n (Just k) = Just $ k+n+ f n _ = Just n+ go (Group n a) = M.alter (f n) a++------------------------------------------------------------------+------------------------------------------------------------------+-- Filtering++-- | Break a grouped list in the elements that match a given condition+-- and those that don't.+partition :: Eq a => (a -> Bool) -> Grouped a -> (Grouped a, Grouped a)+partition f (Grouped xs) = foldr go (mempty, mempty) xs+ where+ go g (gtrue,gfalse) =+ if f $ groupElement g+ then (fromGroup g <> gtrue,gfalse)+ else (gtrue,fromGroup g <> gfalse)++-- | Filter a grouped list by keeping only those that match a given condition.+filter :: Eq a => (a -> Bool) -> Grouped a -> Grouped a+filter f = fst . partition f++------------------------------------------------------------------+------------------------------------------------------------------+-- Indexing++-- | Retrieve the element at the given index. If the index is+-- out of the list index range, it returns 'Nothing'.+index :: Grouped a -> Int -> Maybe a+index (Grouped gs) k = if k < 0 then Nothing else go 0 $ toList gs+ where+ go i (Group n a : xs) =+ let i' = i + n+ in if k < i'+ then Just a+ else go i' xs+ go _ [] = Nothing++-- | Update the element at the given index. If the index is out of range,+-- the original list is returned.+adjust :: Eq a => (a -> a) -> Int -> Grouped a -> Grouped a+adjust f k g@(Grouped gs) = if k < 0 then g else Grouped $ go 0 k gs+ where+ -- Pre-condition: 0 <= i+ go npre i gseq =+ case S.viewl gseq of+ Group n a S.:< xs ->+ let pre = S.take npre gs+ in case () of+ -- This condition implies the change only affects current group.+ -- Furthermore:+ --+ -- i < n - 1 ==> i + 1 < n+ -- 0 <= i ==> 1 <= i + 1 < n ==> n > 1+ --+ -- Therefore, in this case we know n > 1.+ --+ _ | i < n - 1 -> pre S.><+ let a' = f a+ in if a == a'+ then gseq+ else if i == 0+ then Group 1 a' S.<| Group (n-1) a S.<| xs+ -- Note: i + 1 < n ==> 0 < n - (i+1)+ else Group i a S.<| Group 1 a' S.<| Group (n - (i+1)) a S.<| xs+ -- This condition implies the change affects the current group, and can+ -- potentially affect the next group.+ _ | i == n - 1 -> pre S.><+ let a' = f a+ in if a == a'+ then gseq+ else if n == 1+ then case S.viewl xs of+ Group m b S.:< ys ->+ if a' == b+ then Group (m+1) b S.<| ys+ else Group 1 a' S.<| xs+ _ -> S.singleton $ Group 1 a'+ -- In this branch, n > 1+ else case S.viewl xs of+ Group m b S.:< ys ->+ if a' == b+ then Group (n-1) a S.<| Group (m+1) b S.<| ys+ else Group (n-1) a S.<| Group 1 a' S.<| xs+ _ -> S.fromList [ Group (n-1) a , Group 1 a' ]+ -- This condition implies the change affects the next group, and can+ -- potentially affect the current group and the next to the next group.+ _ | i == n -> pre S.><+ case S.viewl xs of+ Group m b S.:< ys ->+ let b' = f b+ in if b == b'+ then gseq+ else if m == 1+ then if a == b'+ then case S.viewl ys of+ Group l c S.:< zs ->+ if a == c+ then Group (n+1+l) a S.<| zs+ else Group (n+1) a S.<| ys+ _ -> S.singleton $ Group (n+1) a+ else Group n a S.<|+ case S.viewl ys of+ Group l c S.:< zs ->+ if b' == c+ then Group (l+1) c S.<| zs+ else Group 1 b' S.<| ys+ _ -> S.singleton $ Group 1 b'+ -- In this branch, m > 1+ else if a == b'+ then Group (n+1) a S.<| Group (m-1) b S.<| ys+ else Group n a S.<| Group 1 b' S.<| Group (m-1) b S.<| ys+ _ -> S.singleton $ Group n a+ -- Otherwise, the current group isn't affected at all.+ -- Note: n < i ==> 0 < i - n+ _ | otherwise -> go (npre+1) (i-n) xs+ _ -> S.empty++------------------------------------------------------------------+------------------------------------------------------------------+-- Traversal++-- | Apply a function with results residing in an applicative functor to every+-- element in a grouped list.+traverseGrouped :: (Applicative f, Eq b) => (a -> f b) -> Grouped a -> f (Grouped b)+traverseGrouped f = foldr (\x fxs -> mappend <$> (point <$> f x) <*> fxs) (pure mempty)++-- | Similar to 'traverseGrouped', but instead of applying a function to every element+-- of the list, it is applied to groups of consecutive elements. You might return more+-- than one element, so the result is of type 'Grouped'. The results are then concatenated+-- into a single value, embedded in the applicative functor.+traverseGroupedByGroup :: (Applicative f, Eq b) => (Group a -> f (Grouped b)) -> Grouped a -> f (Grouped b)+traverseGroupedByGroup f (Grouped gs) = fold <$> traverse f gs++-- | Like 'traverseGroupedByGroup', but carrying an accumulator.+-- Note the 'Monad' constraint instead of 'Applicative'.+traverseGroupedByGroupAccum ::+ (Monad m, Eq b)+ => (acc -> Group a -> m (acc, Grouped b))+ -> acc -- ^ Initial value of the accumulator.+ -> Grouped a+ -> m (acc, Grouped b)+traverseGroupedByGroupAccum f acc0 (Grouped gs) = foldrM go (acc0, mempty) gs+ where+ go g (acc, gd) = second (<> gd) <$> f acc g
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Daniel Díaz++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Daniel Díaz nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,23 @@+# grouped-list++Welcome to the `grouped-list` repository.++We are at an early stage of development, but+contributions are more than welcome. If you+are interested, feel free to submit a pull+request.++# What is this about?++This library defines the type of grouped lists,+``Grouped``. Values of this type are lists+with a finite number of elements. The only+special feature is that consecutive elements+that are equal on the list are internally+represented as a single element annotated+with the number of repetitions. Therefore,+operations on lists that have many consecutive+repetitions perform much better, and memory+usage is reduced. However, this type is suboptimal+for lists that do not have many consecutive+repetitions. We are trying to ameliorate this.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,61 @@++module Main (main) where++import Data.GroupedList (Grouped)+import qualified Data.GroupedList as G+import Criterion.Main+ ( defaultMainWith, bgroup, bench, nf+ , Benchmarkable, Benchmark+ , defaultConfig+ )+import Criterion.Types (reportFile)++sampleSize :: Int+sampleSize = 1000++sampleSize2 :: Int+sampleSize2 = div sampleSize 2++uniform :: Grouped Int+{-# NOINLINE uniform #-}+uniform = G.fromList $ replicate sampleSize 0++increasing :: Grouped Int+{-# NOINLINE increasing #-}+increasing = G.fromList [1 .. sampleSize]++halfuniform :: Grouped Int+{-# NOINLINE halfuniform #-}+halfuniform = G.fromList $ replicate sampleSize2 0 ++ [1 .. sampleSize2]++halfincreasing :: Grouped Int+{-# NOINLINE halfincreasing #-}+halfincreasing = G.fromList $ [1 .. sampleSize2] ++ replicate sampleSize2 0++interleaved :: Grouped Int+{-# NOINLINE interleaved #-}+interleaved = G.fromList $ concat $ zipWith (\x y -> [x,y]) (replicate sampleSize2 0) [1 .. sampleSize2]++halflist :: Grouped Int+{-# NOINLINE halflist #-}+halflist = G.fromList [1 .. sampleSize2]++benchGroup :: String -> (Grouped Int -> Benchmarkable) -> Benchmark+benchGroup n f = bgroup n $ fmap (\(bn,xs) -> bench bn $ f xs)+ [ ("uniform", uniform)+ , ("increasing", increasing)+ , ("halfuniform", halfuniform)+ , ("halfincreasing" , halfincreasing)+ , ("interleaved", interleaved)+ ]++main :: IO ()+main = defaultMainWith (defaultConfig { reportFile = Just "grouped-list-bench.html" })+ [ benchGroup "map id" $ nf $ G.map id+ , benchGroup "map +1" $ nf $ G.map (+1)+ , benchGroup "map const" $ nf $ G.map (const True)+ , benchGroup "adjust 0/2" $ nf $ G.adjust (+1) 0+ , benchGroup "adjust 1/2" $ nf $ G.adjust (+1) $ sampleSize2 + 1+ , benchGroup "adjust 2/2" $ nf $ G.adjust (+1) $ sampleSize - 1+ , bench "mappend" $ nf (\xs -> mappend xs xs) halflist+ ]
+ grouped-list.cabal view
@@ -0,0 +1,49 @@+name: grouped-list+version: 0.1.0.0+synopsis: Grouped lists. Equal consecutive elements are grouped.+description:+ Grouped lists work like regular lists, except for two conditions:+ .+ * Grouped lists are always finite. Attempting to construct an infinite+ grouped list will result in an infinite loop.+ .+ * Grouped lists internally represent consecutive equal elements as only+ one, hence the name of /grouped lists/.+ .+ This mean that grouped lists are ideal for cases where the list has many+ repetitions (like @[1,1,1,1,7,7,7,7,7,7,7,7,2,2,2,2,2]@, although they might+ present some deficiencies in the absent of repetitions.+ .+ /Warning: this library is in early development./+license: BSD3+license-file: LICENSE+author: Daniel Díaz+maintainer: dhelta.diaz@gmail.com+category: Data+build-type: Simple+cabal-version: >=1.10+bug-reports: https://github.com/Daniel-Diaz/grouped-list/issues+homepage: https://github.com/Daniel-Diaz/grouped-list/blob/master/README.md+extra-source-files: README.md++library+ default-language: Haskell2010+ exposed-modules: Data.GroupedList+ build-depends:+ base >= 4.8 && < 5+ , containers+ , pointed+ , deepseq+ ghc-options: -O2 -Wall++benchmark grouped-list-bench+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ main-is: Main.hs+ ghc-options: -O2 -Wall+ build-depends: base >= 4.8, grouped-list, criterion++source-repository head+ type: git+ location: https://github.com/Daniel-Diaz/grouped-list.git