[Haskell-cafe] Re: Why is there no splitBy in the list module?
Christian Maeder
maeder at tzi.de
Fri Jul 21 09:01:10 EDT 2006
Jon Fairbairn schrieb:
>> module Parts (parts, fromParts, contiguousParts, segmentsSatisfying) where
ok, the functions "parts" has added value, but I find its type (using
"Either") ugly.
parts :: (a -> Bool) -> [a] -> [Either [a] [a]]
>> import List (groupBy)
>
>> parts p = map hack . groupBy sameSide . map (predicateToEither p)
I'ld rather see:
parts' :: (a -> Bool) -> [a] -> [[a]]
parts' p = groupBy (\ a b -> p a == p b)
or:
parts'' :: (a -> Bool) -> [a] -> [[(Bool, a)]]
parts'' p = groupBy (\ a b -> fst a == fst b)
. map (\ a -> (p a, a))
parts' has a simple type and a simple property:
id = concat . parts p
but the predicate p is needed again to find out the matching parts (or
if the alternating list of matching and non-matching sublists starts
with a matching or non-matching sublist.)
The function parts'' could be refined to:
parts''' :: (a -> Bool) -> [a] -> [(Bool, [a])]
parts''' p = map (\ l@((b, _) : _) -> (b, map snd l)) . parts'' p
>> segmentsSatisfying predicate
>> = concat . map dropSeps . parts predicate
>> where dropSeps e
>> = case e of
>> Left x -> map (const []) $ tail x
>> Right r -> [r]
>
> So
>
> lines = segmentsSatisfying (/= '\n')
>
> ... but the tail in the definition of segmentsSatisfying
> makes me uneasy.
The (undocumented) property of groupBy is that all element lists are
non-empty!
> needing the function `hack` suggests that the definition of
> parts is written badly
>
>> hack (Left x:rest) = Left (x: map (\(Left x) -> x) rest)
>> hack (Right x:rest) = Right (x: map (\(Right x) -> x) rest)
This hack function would make me more uneasy (if it was exported),
because it only works on non-empty and "sameSided" lists.
The only function that I'm missing is something to manipulate both
arguments of a binary function:
binComp :: (a -> b) -> (b -> b -> c) -> a -> a -> c
binComp f g a b = g (f a) (f b)
This would allow to reformulate my above definitions as:
parts' p = groupBy (binComp p (==))
parts'' p = groupBy (binComp fst (==)) . map (\ a -> (p a, a))
Furthermore, "binComp" would simplify the manipulation of the compare
function. It would make the "comparing" function from
http://www.haskell.org/hawiki/ThingsToAvoid obsolete:
comparing p x y = compare (p x) (p y)
sortBy (comparing (map toLower))
because, one could write:
sortBy (binComp (map toLower) compare)
Cheers Christian
More information about the Libraries
mailing list