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.
I'm trying to convert basic functions into higher order functions (specifically map, filter, or foldr). I was wondering if there are any simple concepts to apply where I could see old functions I've written using guards and turn them into higher order.
I'm working on changing a function called filterFirst that removes the first element from the list (second argument) that does not satisfy a given predicate function (first argument).
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst _ [] = []
filterFirst x (y:ys)
| x y = y : filterFirst x ys
| otherwise = ys
For an example:
greaterOne :: Num a=>Ord a=>a->Bool
greaterOne x = x > 1
filterFirst greaterOne [5,-6,-7,9,10]
[5,-7,9,10]
Based on the basic recursion, I was wondering if there might be a way to translate this (and similar functions) to higher order map, filter, or foldr. I'm not very advanced and these functions are new to me.
There is a higher-order function that's appropriate here, but it's not in the base library. What's the trouble with foldr? If you just fold over the list, you'll end up rebuilding the whole thing, including the part after the deletion.
A more appropriate function for the job is para from the recursion-schemes package (I've renamed one of the type variables):
para :: Recursive t => (Base t (t, r) -> r) -> t -> r
In the case of lists, this specializes to
para :: (ListF a ([a], r) -> r) -> [a] -> r
where
data ListF a b = Nil | Cons a b
deriving (Functor, ....)
This is pretty similar to foldr. The recursion-schemes equivalent of foldr is
cata :: Recursive t => (Base t r -> r) -> t -> r
Which specializes to
cata :: (ListF a r -> r) -> [a] -> r
Take a break here and figure out why the type of cata is basically equivalent to that of foldr.
The difference between cata and para is that para passes the folding function not only the result of folding over the tail of the list, but also the tail of the list itself. That gives us an easy and efficient way to produce the rest of the list after we've found the first non-matching element:
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst f = para go
where
--go :: ListF a ([a], [a]) -> [a]
go (Cons a (tl, r))
| f a = a : r
| otherwise = tl
go Nil = []
para is a bit awkward for lists, since it's designed to fit into a more general context. But just as cata and foldr are basically equivalent, we could write a slightly less awkward function specifically for lists.
foldrWithTails
:: (a -> [a] -> b -> b)
-> b -> [a] -> b
foldrWithTails f n = go
where
go (a : as) = f a as (go as)
go [] = n
Then
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst f = foldrWithTails go []
where
go a tl r
| f a = a : r
| otherwise = tl
First, let's flip the argument order of your function. This will make a few steps easier, and we can flip it back when we're done. (I'll call the flipped version filterFirst'.)
filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] _ = []
filterFirst' (y:ys) x
| x y = y : filterFirst' ys x
| otherwise = ys
Note that filterFirst' ys (const True) = ys for all ys. Let's substitute that in place:
filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] _ = []
filterFirst' (y:ys) x
| x y = y : filterFirst' ys x
| otherwise = filterFirst' ys (const True)
Use if-else instead of a guard:
filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] _ = []
filterFirst' (y:ys) x = if x y then y : filterFirst' ys x else filterFirst' ys (const True)
Move the second argument to a lambda:
filterFirst' :: [a] -> (a -> Bool) -> [a]
filterFirst' [] = \_ -> []
filterFirst' (y:ys) = \x -> if x y then y : filterFirst' ys x else filterFirst' ys (const True)
And now this is something we can turn into a foldr. The pattern we were going for is that filterFirst' (y:ys) can be expressed in terms of filterFirst' ys, without using ys otherwise, and we're now there.
filterFirst' :: Foldable t => t a -> (a -> Bool) -> [a]
filterFirst' = foldr (\y f -> \x -> if x y then y : f x else f (const True)) (\_ -> [])
Now we just need to neaten it up a bit:
filterFirst' :: Foldable t => t a -> (a -> Bool) -> [a]
filterFirst' = foldr go (const [])
where go y f x
| x y = y : f x
| otherwise = f (const True)
And flip the arguments back:
filterFirst :: Foldable t => (a -> Bool) -> t a -> [a]
filterFirst = flip $ foldr go (const [])
where go y f x
| x y = y : f x
| otherwise = f (const True)
And we're done. filterFirst implemented in terms of foldr.
Addendum: Although filter isn't strong enough to build this, filterM is when used with the State monad:
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.State
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst x ys = evalState (filterM go ys) False
where go y = do
alreadyDropped <- get
if alreadyDropped || x y then
return True
else do
put True
return False
If we really want, we can write filterFirst using foldr, since foldr is kind of "universal" -- it allows any list transformation we can perform using recursion. The main downside is that the resulting code is rather counter-intuitive. In my opinion, explicit recursion is far better in this case.
Anyway here's how it is done. This relies on what I consider to be an antipattern, namely "passing four arguments to foldr". I call this an antipattern since foldr is usually called with three arguments only, and the result is not a function taking a fourth argument.
filterFirst :: (a->Bool)->[a]->[a]
filterFirst p xs = foldr go (\_ -> []) xs True
where
go y ys True
| p y = y : ys True
| otherwise = ys False
go y ys False = y : ys False
Clear? Not very much. The trick here is to exploit foldr to build a function Bool -> [a] which returns the original list if called with False, and the filtered-first list if called with True. If we craft that function using
foldr go baseCase xs
the result is then obviously
foldr go baseCase xs True
Now, the base case must handle the empty list, and in such case we must return a function returning the empty list, whatever the boolean argument is. Hence, we arrive at
foldr go (\_ -> []) xs True
Now, we need to define go. This takes as arguments:
a list element y
the result of the "recursion" ys (a function Bool->[a] for the rest of the list)
and must return a function Bool->[a] for the larger list. So let's also consider
a boolean argument
and finally make go return a list. Well, if the boolean is False we must return the list unchanged, so
go y ys False = y : ys False
Note that ys False means "the tail unchanged", so we are really rebuilding the whole list unchanged.
If instead the boolean is true, we query the predicate as in p y. If that is false, we discard y, and return the list tail unchanged
go y ys True
| p y = -- TODO
| otherwise = ys False
If p y is true, we keep y and we return the list tail filtered.
go y ys True
| p y = y : ys True
| otherwise = ys False
As a final note, we cold have used a pair ([a], [a]) instead of a function Bool -> [a], but that approach does not generalize as well to more complex cases.
So, that's all. This technique is something nice to know, but I do not recommend it in real code which is meant to be understood by others.
Joseph and chi's answers already show how to derive a foldr implementation, so I'll try to aid intuition.
map is length-preserving, filterFirst is not, so trivially map must be unsuited for implementing filterFirst.
filter (and indeed map) are memoryless - the same predicate/function is applied to each element of the list, regardless of the result on other elements. In filterFirst, behaviour changes once we see the first non-satisfactory element and remove it, so filter (and map) are unsuited.
foldr is used to reduce a structure to a summary value. It's very general, and it might not be immediately obvious without experience what sorts of things this may cover. filterFirst is in fact such an operation, though. The intuition is something like, "can we build it in a single pass through the structure, building it up as we go(, with additional state stored as required)?". I fear Joseph's answer obfuscates a little, as foldr with 4 parameters, it may not be immediately obvious what's going on, so let's try it a little differently.
filterFirst p xs = snd $ foldr (\a (deleted,acc) -> if not deleted && not (p a) then (True,acc) else (deleted,a:acc) ) (False,[]) xs
Here's a first attempt. The "extra state" here is obviously the bool indicating whether or not we've deleted an element yet, and the list accumulates in the second element of the tuple. At the end we call snd to obtain just the list. This implementation has the problem, however, that we delete the rightmost element not satisfying the predicate, because foldr first combines the rightmost element with the neutral element, then the second-rightmost, and so on.
filterFirst p xs = snd $ foldl (\(deleted,acc) a -> if not deleted && not (p a) then (True,acc) else (deleted,a:acc) ) (False,[]) xs
Here, we try using foldl. This does delete the leftmost non-satisfactory element, but has the side-effect of reversing the list. We can stick a reverse at the front, and this would solve the problem, but is somewhat unsatisfactory due to the double-traversal.
Then, if you go back to foldr, having realized that (basically) if you want transform a list whilst preserving order that foldr is the correct variant, you play with it for a while and end up writing what Joseph suggested. I do however agree with chi that straightforward recursion is the best solution here.
Your function can also be expressed as an unfold, or, more specifically, as an apomorphism. Allow me to begin with a brief explanatory note, before the solution itself.
The apomorphism is the recursion scheme dual to the paramorphism (see dfeuer's answer for more about the latter). Apomorphisms are examples of unfolds, which generate a structure from a seed. For instance, Data.List offers unfoldr, a list unfold.
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
The function given to unfoldr takes a seed and either produces a list element and a new seed (if the maybe-value is a Just) or terminates the list generation (if it is Nothing). Unfolds are more generally expressed by the ana function from recursion-schemes ("ana" is short for "anamorphism").
ana :: Corecursive t => (a -> Base t a) -> a -> t
Specialised to lists, this becomes...
ana #[_] :: (b -> ListF a b) -> b -> [a]
... which is unfoldr in different clothing.
An apomorphism is an unfold in which the generation of the structure can be short-circuited at any point of the process, by producing, instead of a new seed, the rest of the structure in a fell swoop. In the case of lists, we have:
apo #[_] :: (b -> ListF a (Either [a] b)) -> b -> [a]
Either is used to trigger the short-circuit: with a Left result, the unfold short-circuits, while with a Right it proceeds normally.
The solution in terms of apo is fairly direct:
{-# LANGUAGE LambdaCase #-}
import Data.Functor.Foldable
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst p = apo go
where
go = \case
[] -> Nil
a : as
| p a -> Cons a (Right as)
| otherwise -> case as of
[] -> Nil
b : bs -> Cons b (Left bs)
It is somewhat more awkward than dfeuer's para-based solution, because if we want to short-circuit without an empty list for a tail we are compelled to emit one extra element (the b in the short-circuiting case), and so we have to look one position ahead. This awkwardness would grow by orders of magnitude if, rather than filterFirst, we were to impĺement plain old filter with an unfold, as beautifully explained in List filter using an anamorphism.
This answer is inspired by a comment from luqui on a now-deleted question.
filterFirst can be implemented in a fairly direct way in terms of span:
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst p = (\(yeas, rest) -> yeas ++ drop 1 rest) . span p
span :: (a -> Bool) -> [a] -> ([a], [a]) splits the list in two at the first element for which the condition doesn't hold. After span, we drop the first element of the second part of the list (with drop 1 rather than tail so that we don't have to add a special case for []), and reassemble the list with (++).
As an aside, there is a near-pointfree spelling of this implementation which I find too pretty not to mention:
filterFirst :: (a -> Bool) -> [a] -> [a]
filterFirst p = uncurry (++) . second (drop 1) . span p
While span is a higher order function, it would be perfectly understandable if you found this implementation disappointing in the context of your question. After all, span is not much more fundamental than filterFirst itself. Shouldn't we try going a little deeper, to see if we can capture the spirit of this solution while expressing it as a fold, or as some other recursion scheme?
I believe functions like filterFirst can be fine demonstrations of hylomorphisms. A hylomorphism is an unfold (see my other answer for more on that) that generates an intermediate data structure followed by a fold which turns this data structure into something else. Though it might look like that would require two passes to get a result (one through the input structure, and another through the intermediate one), if the hylomorphism implemented properly (as done in the hylo function of recursion-schemes) it can be done in a single pass, with the fold consuming pieces of the intermediate structure as they are generated by the unfold (so that we don't have to actually build it all only to tear it down).
Before we start, here is the boilerplate needed to run what follows:
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
import Data.Functor.Foldable
import Data.Functor.Foldable.TH
The strategy here is picking an intermediate data structure for the hylomorphism that expresses the essence of what we want to achieve. In this case, we will use this cute thing:
data BrokenList a = Broken [a] | Unbroken a (BrokenList a)
-- I won't actually use those instances here,
-- but they are nice to have if you want to play with the type.
deriving (Eq, Show, Functor, Foldable, Traversable)
makeBaseFunctor ''BrokenList
BrokenList is very much like a list (Broken and Unbroken mirror [] and (:), while the makeBaseFunctor incantation generates a BrokenListF base functor analogous to ListF, with BrokenF and UnbrokenF constructors), except that it has another list attached at its end (the Broken constructor). It expresses, in a quite literal way, the idea of a list being divided in two parts.
With BrokenList at hand, we can write the hylomorphism. coalgSpan is the operation used for the unfold, and algWeld, the one used for the fold.
filterFirst p = hylo algWeld coalgSpan
where
coalgSpan = \case
[] -> BrokenF []
x : xs
| p x -> UnbrokenF x xs
| otherwise -> BrokenF xs
algWeld = \case
UnbrokenF x yeas -> x : yeas
BrokenF rest -> rest
coalgSpan breaks the list upon hitting a x element such that p x doesn't hold. Not adding that element to the second part of the list (BrokenF xs rather than BrokenF (x : xs)) takes care of the filtering. As for algWeld, it is used to concatenate the two parts (it is very much like what we would use to implement (++) using cata).
(For a similar example of BrokenList in action, see the breakOn implementation in Note 5 of this older answer of mine. It suggests what it would take to implement span using this strategy.)
There are at least two good things about this hylo-based implementation. Firstly, it has good performance (casual testing suggests that, if compiled with optimisations, it is at least as good as, and possibly slightly faster than, the most efficient implementations in other answers here). Secondly, it reflects very closely your original, explicitly recursive implementation of filterFirst (or, at any rate, more closely than the fold-only and unfold-only implementations).
The following function is not in the standard Haskell libraries, so I wrote it:
paginate _ [] = []
paginate n xs = let (h, t) = splitAt n xs in h : paginate n t
Then I wanted to rewrite it without the explicit recursion yet still be easily understandable.
I've tried the fix version, which does not yield very satisfactory results:
paginate = fix go
where
go _ _ [] = []
go v n xs = let (h, t) = splitAt n xs in h : v n t
Are there simpler solutions which use the Prelude functions?
When I see this sort of problem, I like to think about the "shape" of the function you want. In this case, you're starting with a list and producing a list of lists. This is a special case of starting with a single value and producing a list, which corresponds to an unfold. So, if you don't mind importing Data.List, you can neatly write your function using unfoldr.
Lets take a look at how to derive this step by step. First, as above, you just have to know about unfoldr and see that it can apply. This is where a bit of experience (like reading answers like this one :)) comes in.
Next, we take a look at the type of unfoldr:
Prelude Data.List> :t unfoldr
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
The idea is that we start with a single "kernel" value (b), and apply a step function (b -> Maybe (a, b)) repeatedly until we hit Nothing. Our starting value is the list we want to separate into chunks, so we don't need to do any more processing there. This means the last step we have is implementing the step function.
Since we're starting with a list of values, we can replace b with [n]; moreover, since we want to produce a list of lists at the very end, we can replace [a] with [[n]] and, therefore, a with [n]. This gives us the final type we have to implement for the step function:
[n] -> Maybe ([n], [n])
Hey, that looks very similar to the type of splitAt!
splitAt :: Int -> a -> ([a], [a])
In fact, we can just wrap the result of splitAt in Just and satify our types. But this leaves out a very important part: the final Nothing that tells unfoldr to stop! So our helper function needs an extra base case for [] to return the right result.
Putting it all together gives us the final function:
import Data.List (unfoldr)
paginate n = unfoldr go
where go [] = Nothing -- base case
go ls = Just (splitAt n ls)
I think the end result is pretty good, but I'm not sure it's any more readable than the recursive version.
If you don't mind enabling an extension (LambdaCase), you can rewrite this in a slightly neater way by avoiding naming go:
paginate n = unfoldr $ \case
[] -> Nothing
ls -> Just (splitAt n ls)
FYI, following from Tikhon Jelvis' answer, I eventually ended up with:
boolMaybe p f x = if p x then Just (f x) else Nothing
groupWith = unfoldr . boolMaybe null
paginate = groupWith . splitAt
which is a bit too obfuscated for me. Back to the recursive version.
Here is a slightly changed version of the Tikhon Jelvis' code:
import Data.Maybe
import Data.List
import Control.Applicative
paginate n = unfoldr $ \xs -> listToMaybe xs *> Just (splitAt n xs)
Or in pointfree:
paginate n = unfoldr $ (*>) <$> listToMaybe <*> Just . splitAt n
there's always been this:
import Data.List
chunks n = takeWhile (not . null) . unfoldr (Just . splitAt n)
but the new champion, for me, is
import Data.Maybe -- additional imports
import Control.Applicative
chunks n = unfoldr $ (<$) . splitAt n <*> listToMaybe
-- \xs -> splitAt n xs <$ listToMaybe xs
(tweaking just a little bit the code from this comment by #user3237465).
The bits used here are:
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
(f <*> g) x = f x (g x) -- S combinator
x <$ c = fmap (const x) c -- "mapped into"
listToMaybe xs = head (map Just xs ++ [Nothing])
Another, similar way to write it is
import Control.Monad -- an additional import
chunks n = unfoldr $ listToMaybe . join ((<$) . splitAt n)
-- \xs -> listToMaybe (splitAt n xs <$ xs)
using the monadic join for functions,
join f x = f x x -- W combinator
I have a type synonym type Entity = ([Feature], Body) for whatever Feature and Body mean. Objects of Entity type are to be grouped together:
type Bunch = [Entity]
and the assumption, crucial for the algorithm working with Bunch, is that any two entities in the same bunch have the equal number of features.
If I were to implement this constraint in an OOP language, I would add the corresponding check to the method encapsulating the addition of entities into a bunch.
Is there a better way to do it in Haskell? Preferably, on the definition level. (If the definition of Entity also needs to be changed, no problem.)
Using type-level length annotations
So here's the deal. Haskell does have type-level natural numbers and you can annotate with types using "phantom types". However you do it, the types will look like this:
data Z
data S n
data LAList x len = LAList [x] -- length-annotated list
Then you can add some construction functions for convenience:
lalist1 :: x -> LAList x (S Z)
lalist1 x = LAList [x]
lalist2 :: x -> x -> LAList x (S (S Z))
lalist2 x y = LAList [x, y]
-- ...
And then you've got more generic methods:
(~:) :: x -> LAList x n -> LAList x (S n)
x ~: LAList xs = LAList (x : xs)
infixr 5 ~:
nil :: LAList x Z
nil = LAList []
lahead :: LAList x (S n) -> x
lahead (LAList xs) = head xs
latail :: LAList x (S n) -> LAList x n
latail (LAList xs) = tail xs
but by itself the List definition doesn't have any of this because it's complicated. You may be interested in the Data.FixedList package for a somewhat different approach, too. Basically every approach is going to start off looking a little weird with some data type that has no constructor, but it starts to look normal after a little bit.
You might also be able to get a typeclass so that all of the lalist1, lalist2 operators above can be replaced with
class FixedLength t where
la :: t x -> LAList x n
but you will probably need the -XTypeSynonymInstances flag to do this, as you want to do something like
type Pair x = (x, x)
instance FixedLength Pair where
la :: Pair x -> LAList [x] (S (S Z))
la (a, b) = LAList [a, b]
(it's a kind mismatch when you go from (a, b) to Pair a).
Using runtime checking
You can very easily take a different approach and encapsulate all of this as a runtime error or explicitly model the error in your code:
-- this may change if you change your definition of the Bunch type
features :: Entity -> [Feature]
features = fst
-- we also assume a runBunch :: [Entity] -> Something function
-- that you're trying to run on this Bunch.
allTheSame :: (Eq x) => [x] -> Bool
allTheSame (x : xs) = all (x ==) xs
allTheSame [] = True
permissiveBunch :: [Entity] -> Maybe Something
permissiveBunch es
| allTheSame (map (length . features) es) = Just (runBunch es)
| otherwise = Nothing
strictBunch :: [Entity] -> Something
strictBunch es
| allTheSame (map (length . features) es) = runBunch es
| otherwise = error ("runBunch requires all feature lists to be the same length; saw instead " ++ show (map (length . features) es))
Then your runBunch can just assume that all the lengths are the same and it's explicitly checked for above. You can get around pattern-matching weirdnesses with, say, the zip :: [a] -> [b] -> [(a, b)] function in the Prelude, if you need to pair up the features next to each other. (The goal here would be an error in an algorithm due to pattern-matching for both runBunch' (x:xs) (y:ys) and runBunch' [] [] but then Haskell warns that there are 2 patterns which you've not considered in the match.)
Using tuples and type classes
One final way to do it which is a compromise between the two (but makes for pretty good Haskell code) involves making Entity parametrized over all features:
type Entity x = (x, Body)
and then including a function which can zip different entities of different lengths together:
class ZippableFeatures z where
fzip :: z -> z -> [(Feature, Feature)]
instance ZippableFeatures () where
fzip () () = []
instance ZippableFeatures Feature where
fzip f1 f2 = [(f1, f2)]
instance ZippableFeatures (Feature, Feature) where
fzip (a1, a2) (b1, b2) = [(a1, b1), (a2, b2)]
Then you can use tuples for your feature lists, as long as they don't get any larger than the maximum tuple length (which is 15 on my GHC). If you go larger than that, of course, you can always define your own data types, but it's not going to be as general as type-annotated lists.
If you do this, your type signature for runBunch will simply look like:
runBunch :: (ZippableFeatures z) => [Entity z] -> Something
When you run it on things with the wrong number of features you'll get compiler errors that it can't unify the type (a, b) with (a, b, c).
There are various ways to enforce length constraints like that; here's one:
{-# LANGUAGE DataKinds, KindSignatures, GADTs, TypeFamilies #-}
import Prelude hiding (foldr)
import Data.Foldable
import Data.Monoid
import Data.Traversable
import Control.Applicative
data Feature -- Whatever that really is
data Body -- Whatever that really is
data Nat = Z | S Nat -- Natural numbers
type family Plus (m::Nat) (n::Nat) where -- Type level natural number addition
Plus Z n = n
Plus (S m) n = S (Plus m n)
data LList (n :: Nat) a where -- Lists tagged with their length at the type level
Nil :: LList Z a
Cons :: a -> LList n a -> LList (S n) a
Some functions on these lists:
llHead :: LList (S n) a -> a
llHead (Cons x _) = x
llTail :: LList (S n) a -> LList n a
llTail (Cons _ xs) = xs
llAppend :: LList m a -> LList n a -> LList (Plus m n) a
llAppend Nil ys = ys
llAppend (Cons x xs) ys = Cons x (llAppend xs ys)
data Entity n = Entity (LList n Feature) Body
data Bunch where
Bunch :: [Entity n] -> Bunch
Some instances:
instance Functor (LList n) where
fmap f Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
instance Foldable (LList n) where
foldMap f Nil = mempty
foldMap f (Cons x xs) = f x `mappend` foldMap f xs
instance Traversable (LList n) where
traverse f Nil = pure Nil
traverse f (Cons x xs) = Cons <$> f x <*> traverse f xs
And so on. Note that n in the definition of Bunch is existential. It can be anything, and what it actually is doesn't affect the type—all bunches have the same type. This limits what you can do with bunches to a certain extent. Alternatively, you can tag the bunch with the length of its feature lists. It all depends what you need to do with this stuff in the end.
From time to time I stumble over the problem that I want to express "please use the last argument twice", e.g. in order to write pointfree style or to avoid a lambda. E.g.
sqr x = x * x
could be written as
sqr = doubleArgs (*) where
doubleArgs f x = f x x
Or consider this slightly more complicated function (taken from this question):
ins x xs = zipWith (\ a b -> a ++ (x:b)) (inits xs) (tails xs)
I could write this code pointfree if there were a function like this:
ins x = dup (zipWith (\ a b -> a ++ (x:b))) inits tails where
dup f f1 f2 x = f (f1 x) (f2 x)
But as I can't find something like doubleArgs or dup in Hoogle, so I guess that I might miss a trick or idiom here.
From Control.Monad:
join :: (Monad m) -> m (m a) -> m a
join m = m >>= id
instance Monad ((->) r) where
return = const
m >>= f = \x -> f (m x) x
Expanding:
join :: (a -> a -> b) -> (a -> b)
join f = f >>= id
= \x -> id (f x) x
= \x -> f x x
So, yeah, Control.Monad.join.
Oh, and for your pointfree example, have you tried using applicative notation (from Control.Applicative):
ins x = zipWith (\a b -> a ++ (x:b)) <$> inits <*> tails
(I also don't know why people are so fond of a ++ (x:b) instead of a ++ [x] ++ b... it's not faster -- the inliner will take care of it -- and the latter is so much more symmetrical! Oh well)
What you call 'doubleArgs' is more often called dup - it is the W combinator (called warbler in To Mock a Mockingbird) - "the elementary duplicator".
What you call 'dup' is actually the 'starling-prime' combinator.
Haskell has a fairly small "combinator basis" see Data.Function, plus some Applicative and Monadic operations add more "standard" combinators by virtue of the function instances for Applicative and Monad (<*> from Applicative is the S - starling combinator for the functional instance, liftA2 & liftM2 are starling-prime). There doesn't seem to be much enthusiasm in the community for expanding Data.Function, so whilst combinators are good fun, pragmatically I've come to prefer long-hand in situations where a combinator is not directly available.
Here is another solution for the second part of my question: Arrows!
import Control.Arrow
ins x = inits &&& tails >>> second (map (x:)) >>> uncurry (zipWith (++))
The &&& ("fanout") distributes an argument to two functions and returns the pair of the results. >>> ("and then") reverses the function application order, which allows to have a chain of operations from left to right. second works only on the second part of a pair. Of course you need an uncurry at the end to feed the pair in a function expecting two arguments.