Related
(In my actual use case I have a list of type [SomeType], SomeType having a finite number of constructors, all nullary; in the following I'll use String instead of [SomeType] and use only 4 Chars, to simplify a bit.)
I have a list like this "aaassddddfaaaffddsssadddssdffsdf" where each element can be one of 'a', 's', 'd', 'f', and I want to do some further processing on each contiguous sequence of non-as, let's say turning them upper case and reversing the sequence, thus obtaining "aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD". (I've added the reversing requirement to make it clear that the processing involves all the contiguous non 'a'-s at the same time.)
To turn each sub-String upper case, I can use this:
func :: String -> String
func = reverse . map Data.Char.toUpper
But how do I run that func only on the sub-Strings of non-'a's?
My first thought is that Data.List.groupBy can be useful, and the overall solution could be:
concat $ map (\x -> if head x == 'a' then x else func x)
$ Data.List.groupBy ((==) `on` (== 'a')) "aaassddddfaaaffddsssadddssdffsdf"
This solution, however, does not convince me, as I'm using == 'a' both when grouping (which to me seems good and unavoidable) and when deciding whether I should turn a group upper case.
I'm looking for advices on how I can accomplish this small task in the best way.
You could classify the list elements by the predicate before grouping. Note that I’ve reversed the sense of the predicate to indicate which elements are subject to the transformation, rather than which elements are preserved.
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Arrow ((&&&))
import Data.Function (on)
import Data.Monoid (First(..))
mapSegmentsWhere
:: forall a. (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
mapSegmentsWhere p f
= concatMap (applyMatching . sequenceA) -- [a]
. groupBy ((==) `on` fst) -- [[(First Bool, a)]]
. map (First . Just . p &&& id) -- [(First Bool, a)]
where
applyMatching :: (First Bool, [a]) -> [a]
applyMatching (First (Just matching), xs)
= applyIf matching f xs
applyIf :: forall a. Bool -> (a -> a) -> a -> a
applyIf condition f
| condition = f
| otherwise = id
Example use:
> mapSegmentsWhere (/= 'a') (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Here I use the First monoid with sequenceA to merge the lists of adjacent matching elements from [(Bool, a)] to (Bool, [a]), but you could just as well use something like map (fst . head &&& map snd). You can also skip the ScopedTypeVariables if you don’t want to write the type signatures; I just included them for clarity.
If we need to remember the difference between the 'a's and the rest, let's put them in different branches of an Either. In fact, let's define a newtype now that we are at it:
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
import Data.Bifoldable
import Data.Char
import Data.List
newtype Bunched a b = Bunched [Either a b] deriving (Functor, Foldable)
instance Bifunctor Bunched where
bimap f g (Bunched b) = Bunched (fmap (bimap f g) b)
instance Bifoldable Bunched where
bifoldMap f g (Bunched b) = mconcat (fmap (bifoldMap f g) b)
fmap will let us work over the non-separators. fold will return the concatenation of the non-separators, bifold will return the concatenation of everything. Of course, we could have defined separate functions unrelated to Foldable and Bifoldable, but why avoid already existing abstractions?
To split the list, we can use an unfoldr that alternately searches for as and non-as with the span function:
splitty :: Char -> String -> Bunched String String
splitty c str = Bunched $ unfoldr step (True, str)
where
step (_, []) = Nothing
step (True, span (== c) -> (as, ys)) = Just (Left as, (False, ys))
step (False, span (/= c) -> (xs, ys)) = Just (Right xs, (True, ys))
Putting it to work:
ghci> bifold . fmap func . splitty 'a' $ "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Note: Bunched is actually the same as Tannen [] Either from the bifunctors package, if you don't mind the extra dependency.
There are other answers here, but I think they get too excited about iteration abstractions. A manual recursion, alternately taking things that match the predicate and things that don't, makes this problem exquisitely simple:
onRuns :: Monoid m => (a -> Bool) -> ([a] -> m) -> ([a] -> m) -> [a] -> m
onRuns p = go p (not . p) where
go _ _ _ _ [] = mempty
go p p' f f' xs = case span p xs of
(ts, rest) -> f ts `mappend` go p' p f' f rest
Try it out in ghci:
Data.Char> onRuns ('a'==) id (reverse . map toUpper) "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
Here is a simple solution - function process below - that only requires that you define two functions isSpecial and func. Given a constructor from your type SomeType, isSpecial determines whether it is one of those constructors that form a special sublist or not. The function func is the one you included in your question; it defines what should happen with the special sublists.
The code below is for character lists. Just change isSpecial and func to make it work for your lists of constructors.
isSpecial c = c /= 'a'
func = reverse . map toUpper
turn = map (\x -> ([x], isSpecial x))
amalgamate [] = []
amalgamate [x] = [x]
amalgamate ((xs, xflag) : (ys, yflag) : rest)
| xflag /= yflag = (xs, xflag) : amalgamate ((ys, yflag) : rest)
| otherwise = amalgamate ((xs++ys, xflag) : rest)
work = map (\(xs, flag) -> if flag then func xs else xs)
process = concat . work . amalgamate . turn
Let's try it on your example:
*Main> process "aaassddddfaaaffddsssadddssdffsdf"
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
Applying one function at a time, shows the intermediate steps taken:
*Main> turn "aaassddddfaaaffddsssadddssdffsdf"
[("a",False),("a",False),("a",False),("s",True),("s",True),("d",True),
("d",True),("d",True),("d",True),("f",True),("a",False),("a",False),
("a",False),("f",True),("f",True),("d",True),("d",True),("s",True),
("s",True),("s",True),("a",False),("d",True),("d",True),("d",True),
("s",True),("s",True),("d",True),("f",True),("f",True),("s",True),
("d",True),("f",True)]
*Main> amalgamate it
[("aaa",False),("ssddddf",True),("aaa",False),("ffddsss",True),
("a",False),("dddssdffsdf",True)]
*Main> work it
["aaa","FDDDDSS","aaa","SSSDDFF","a","FDSFFDSSDDD"]
*Main> concat it
"aaaFDDDDSSaaaSSSDDFFaFDSFFDSSDDD"
*Main>
We can just do what you describe, step by step, getting a clear simple minimal code which we can easily read and understand later on:
foo :: (a -> Bool) -> ([a] -> [a]) -> [a] -> [a]
foo p f xs = [ a
| g <- groupBy ((==) `on` fst)
[(p x, x) | x <- xs] -- [ (True, 'a'), ... ]
, let (t:_, as) = unzip g -- ( [True, ...], "aaa" )
, a <- if t then as else (f as) ] -- final concat
-- unzip :: [(b, a)] -> ([b], [a])
We break the list into same-p spans and unpack each group with the help of unzip. Trying it out:
> foo (=='a') reverse "aaabcdeaa"
"aaaedcbaa"
So no, using == 'a' is avoidable and hence not especially good, introducing an unnecessary constraint on your data type when all we need is equality on Booleans.
Lambda Expressions can make life easier and I love the way, you can shorten expressions like (\x -> x + 1) to (+1).
That's why I'm wondering if there is anything similar for anonymous functions that take two arguments and return a Ordering.
For example: Can you shorten this code:
sortByFirst :: Ord a => [(a, b)] -> [(a, b)]
sortByFirst = sortBy (\x y -> fst x `compare` fst y)
You could use the on function, from the Data.Function module.
import Data.List
sortByFirst = sortBy (compare `on` fst)
The definition of on is roughly
on f g = \x y -> f (g x) (g y)
With comparing from Data.Ord, it can be spelled as...
sortByFirst = sortBy (comparing fst)
... which is equivalent to is equivalent to the compare `on` fst in chepner's answer.
(Data.List also offers a sortOn :: Ord b => (a -> b) -> [a] -> [a], but that is a special purpose function which is only worth using if the involved a -> b function is somewhat expensive, something that fst is not.)
wondering how to implement nub over a Seq a
I get that one could do:
nubSeq :: Seq a -> Seq a
nubSeq = fromList . nub . toList
Just wondering is there something standard that does not convert to Lists in order to call nub :: [a]->[a]?
An implementation that occurred to me, based obviously on nub, is:
nubSeq :: (Eq a) => Seq a -> Seq a
nubSeq = Data.Sequence.foldrWithIndex
(\_ x a -> case x `Data.Sequence.elemIndexR` a of
Just _ -> a
Nothing -> a |> x) Data.Sequence.empty
But there must be something more elegant?
thanks.
Not sure whether this qualifies as more elegant but it splits the concerns in independent functions (caveat: you need an Ord constraint on a):
seqToNubMap takes a Seq and outputs a Map associating to each a the smallest index at which it appeared in the sequence
mapToList takes a Map of values and positions and produces a list of values in increasing order according to the specified positions
nubSeq combines these to generate a sequence without duplicates
The whole thing should be O(n*log(n)), I believe:
module NubSeq where
import Data.Map as Map
import Data.List as List
import Data.Sequence as Seq
import Data.Function
seqToNubMap :: Ord a => Seq a -> Map a Int
seqToNubMap = foldlWithIndex (\ m k v -> insertWith min v k m) Map.empty
mapToList :: Ord a => Map a Int -> [a]
mapToList = fmap fst . List.sortBy (compare `on` snd) . Map.toList
nubSeq :: Ord a => Seq a -> Seq a
nubSeq = Seq.fromList . mapToList . seqToNubMap
Or a simpler alternative following #DavidFletcher's comment:
nubSeq' :: forall a. Ord a => Seq a -> Seq a
nubSeq' xs = Fold.foldr cons nil xs Set.empty where
cons :: a -> (Set a -> Seq a) -> (Set a -> Seq a)
cons x xs seen
| x `elem` seen = xs seen
| otherwise = x <| xs (Set.insert x seen)
nil :: Set a -> Seq a
nil _ = Seq.empty
Another way with an Ord constraint - use a scan to make the sets of
elements that appear in each prefix of the list. Then we can filter out
any element that's already been seen.
import Data.Sequence as Seq
import Data.Set as Set
nubSeq :: Ord a => Seq a -> Seq a
nubSeq xs = (fmap fst . Seq.filter (uncurry notElem)) (Seq.zip xs seens)
where
seens = Seq.scanl (flip Set.insert) Set.empty xs
Or roughly the same thing as a mapAccumL:
nubSeq' :: Ord a => Seq a -> Seq a
nubSeq' = fmap fst . Seq.filter snd . snd . mapAccumL f Set.empty
where
f s x = (Set.insert x s, (x, x `notElem` s))
(If I was using lists I would use Maybes instead of the pairs with
Bool, then use catMaybes instead of filtering. There doesn't seem to be catMaybes
for Sequence though.)
I think your code should be pretty efficient. Since Sequences are tree data structures using another tree type data structure like Map or HashMap to store and lookup the previous items doesn't make too much sense to me.
Instead i take the first item and check it's existence in the rest. If exists i drop that item and proceed the same with the rest recursively. If not then construct a new sequence with first element is the unique element and the rest is the result of nubSeq fed by the rest. Should be typical. I use ViewPatterns.
{-# LANGUAGE ViewPatterns #-}
import Data.Sequence as Seq
nubSeq :: Eq a => Seq a -> Seq a
nubSeq (viewl -> EmptyL) = empty
nubSeq (viewl -> (x :< xs)) | elemIndexL x xs == Nothing = x <| nubSeq xs
| otherwise = nubSeq xs
*Main> nubSeq . fromList $ [1,2,3,4,4,2,3,6,7,1,2,3,4]
fromList [6,7,1,2,3,4]
In Haskell, I can easily map a list:
map (\x -> 2*x) [1,2]
gives me [2,4]. Is there any "mapTuple" function which would work like that?
mapTuple (\x -> 2*x) (1,2)
with the result being (2,4).
Here's a rather short point-free solution:
import Control.Monad (join)
import Control.Arrow ((***))
mapTuple = join (***)
Searching at Hoogle gives no exact matches for (a -> b) -> (a, a) -> (b, b), which is the type you require, but it is pretty easy to do yourself:
mapTuple :: (a -> b) -> (a, a) -> (b, b)
mapTuple f (a1, a2) = (f a1, f a2)
Note, you will have to define a new function for 3-tuples, 4-tuples etc - although such a need might be a sign, that you are not using tuples like they were intended: In general, tuples hold values of different types, so wanting to apply a single function to all values is not very common.
You could use Bifunctor:
import Control.Monad (join)
import Data.Bifunctor (bimap)
join bimap (2*) (1,2)
This works not only for pairs, but for a number of other types as well, e.g. for Either.
Bifunctor is in base as of version 4.8. Previously it was provided by the bifunctors package.
You can also use lens to map tuples:
import Control.Lens
mapPair = over both
Or you can map over tuples with upto 10 elements:
mapNtuple f = traverseOf each (return . f)
You can use arrows from module Control.Arrow to compose functions that work on tuples.
Prelude Control.Arrow> let f = (*2) *** (*2)
Prelude Control.Arrow> f (1,2)
(2,4)
Prelude Control.Arrow> let f' = (*2) *** (*3)
Prelude Control.Arrow> f (2,2)
(4,4)
Prelude Control.Arrow> f' (2,2)
(4,6)
Your mapTuple then becomes
mapTuple f = f *** f
If with your question you asked for a function that maps over tuples of arbitrary arity, then I'm afraid you can't because they would have different types (e.g. the tuple types (a,b) and (a,b,c) are totally different and unrelated).
Here is another way:
mapPair :: (a -> b) -> (a, a) -> (b, b) -- this is the inferred type
mapPair f = uncurry ((,) `on` f)
You need Data.Function imported for on function.
To add another solution to this colourful set... You can also map over arbitrary n-tuples using Scrap-Your-Boilerplate generic programming. For example:
import Data.Data
import Data.Generics.Aliases
double :: Int -> Int
double = (*2)
tuple :: (Int, Int, Int, Int)
tuple = gmapT (mkT double) (1,2,3,4)
Note that the explicit type annotations are important, as SYB selects the fields by type. If one makes one tuple element type Float, for example, it wouldn't be doubled anymore.
Yes, for tuples of 2 items, you can use first and second to map the contents of a tuple (Don't worry about the type signature; a b c can be read as b -> c in this situation). For larger tuples, you should consider using a data structure and lenses instead.
The extra package provides the both function in the Data.Tuple.Extra module. From the docs:
Apply a single function to both components of a pair.
> both succ (1,2) == (2,3)
both :: (a -> b) -> (a, a) -> (b, b)
You can also use Applicatives which have additional benefit of giving you possibility to apply different functions for each tuple element:
import Control.Applicative
mapTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
mapTuple f g = (,) <$> f . fst <*> g . snd
Inline version:
(\f -> (,) <$> f . fst <*> f . snd) (*2) (3, 4)
or with different map functions and without lambda:
(,) <$> (*2) . fst <*> (*7) . snd $ (3, 4)
Other possibility would be to use Arrows:
import Control.Arrow
(+2) . fst &&& (+2) . snd $ (2, 3)
I just added a package tuples-homogenous-h98 to Hackage that solves this problem. It adds newtype wrappers for tuples and defines Functor, Applicative, Foldable and Traversable instances for them. Using the package you can do things like:
untuple2 . fmap (2 *) . Tuple2 $ (1, 2)
or zip tuples like:
Tuple2 ((+ 1), (*2)) <*> Tuple2 (1, 10)
The uniplate package provides the descend function in the Data.Generics.Uniplate.Data module. This function will apply the function everywhere the types match, so can be applied to lists, tuples, Either, or most other data types. Some examples:
descend (\x -> 2*x) (1,2) == (2,4)
descend (\x -> 2*x) (1,"test",Just 2) == (2,"test",Just 4)
descend (\x -> 2*x) (1,2,3,4,5) == (2,4,6,8,10)
descend (\x -> 2*x) [1,2,3,4,5] == [2,4,6,8,10]
Yes, you would do:
map (\x -> (fst x *2, snd x *2)) [(1,2)]
fst grabs the first data entry in a tuple, and snd grabs the second; so, the line of code says "take a tuple, and return another tuple with the first and second items double the previous."
I need binary combinators of the type
(a -> Bool) -> (a -> Bool) -> a -> Bool
or maybe
[a -> Bool] -> a -> Bool
(though this would just be the foldr1 of the first, and I usually only need to combine two boolean functions.)
Are these built-in?
If not, the implementation is simple:
both f g x = f x && g x
either f g x = f x || g x
or perhaps
allF fs x = foldr (\ f b -> b && f x) True fs
anyF fs x = foldr (\ f b -> b || f x) False fs
Hoogle turns up nothing, but sometimes its search doesn't generalise properly. Any idea if these are built-in? Can they be built from pieces of an existing library?
If these aren't built-in, you might suggest new names, because these names are pretty bad. In fact that's the main reason I hope that they are built-in.
Control.Monad defines an instance Monad ((->) r), so
ghci> :m Control.Monad
ghci> :t liftM2 (&&)
liftM2 (&&) :: (Monad m) => m Bool -> m Bool -> m Bool
ghci> liftM2 (&&) (5 <) (< 10) 8
True
You could do the same with Control.Applicative.liftA2.
Not to seriously suggest it, but...
ghci> :t (. flip ($)) . flip all
(. flip ($)) . flip all :: [a -> Bool] -> a -> Bool
ghci> :t (. flip ($)) . flip any
(. flip ($)) . flip any :: [a -> Bool] -> a -> Bool
It's not a builtin, but the alternative I prefer is to use type classes to generalize
the Boolean operations to predicates of any arity:
module Pred2 where
class Predicate a where
complement :: a -> a
disjoin :: a -> a -> a
conjoin :: a -> a -> a
instance Predicate Bool where
complement = not
disjoin = (||)
conjoin = (&&)
instance (Predicate b) => Predicate (a -> b) where
complement = (complement .)
disjoin f g x = f x `disjoin` g x
conjoin f g x = f x `conjoin` g x
-- examples:
ge :: Ord a => a -> a -> Bool
ge = complement (<)
pos = (>0)
nonzero = pos `disjoin` (pos . negate)
zero = complement pos `conjoin` complement (pos . negate)
I love Haskell!
I don't know builtins, but I like the names you propose.
getCoolNumbers = filter $ either even (< 42)
Alternately, one could think of an operator symbol in addition to typeclasses for alternatives.
getCoolNumbers = filter $ even <|> (< 42)