I need to write a function which checks if a list has two or more same elements and returns true or false.
For example [3,3,6,1] should return true, but [3,8] should return false.
Here is my code:
identical :: [Int] -> Bool
identical x = (\n-> filter (>= 2) n )( group x )
I know this is bad, and it does not work.
I wanted to group the list into list of lists, and if the length of a list is >= 2, then it is should return with true otherwise false.
Use any to get a Bool result.
any ( . . . ) ( group x )
Don’t forget to sort the list, group works on consecutive elements.
any ( . . . ) ( group ( sort x ) )
You can use (not . null . tail) for a predicate, as one of the options.
Just yesterday I posted a similar algorithm here. A possible way to go about it is,
generate the sequence of cumulative sets of elements
{}, {x0}, {x0,x1}, {x0,x1,x2} ...
pair the original sequence of elements with the cumulative sets
x0, x1 , x2 , x3 ...
{}, {x0}, {x0,x1}, {x0,x1,x2} ...
check repeated insertions, i.e.
xi such that xi ∈ {x0..xi-1}
This can be implemented for instance, via the functions below.
First we use scanl to iteratively add the elements of the list to a set, producing the cumulative sequence of these iterations.
sets :: [Int] -> [Set Int]
sets = scanl (\s x -> insert x s) empty
Then we zip the original list with this sequence, so each xi is paired with {x0...xi-1}.
elsets :: [Int] -> [(Int, Set Int)]
elsets xs = zip xs (sets xs)
Finally we use find to search for an element that is "about to be inserted" in a set which already contains it. The function find returns the pair element / set, and we pattern match to keep only the element, and return it.
result :: [Int] -> Maybe Int
result xs = do (x,_) <- find(\(y,s)->y `elem` s) (elsets xs)
return x
The another way to do that using Data.Map as below is not efficient than ..group . sort.. solution, it is still O(n log n) but able to work with infinite list.
import Data.Map.Lazy as Map (empty, lookup, insert)
identical :: [Int] -> Bool
identical = loop Map.empty
where loop _ [] = False
loop m (x:xs) = if Map.lookup x m == Nothing
then loop (insert x 0 m) xs
else True
OK basically this is one of the rare cases where you really need sort for efficiency. In fact Data.List.Unique package has a repeated function just for this job and if the source is checked one can see that sort and group strategy is chosen. I guess this is not the most efficient algorithm. I will come to how we can make sort even more efficient but for the time being let's enjoy a little since this is a nice question.
So we have the tails :: [a] -> [[a]] functions in Data.List package. Accordingly;
*Main> tails [3,3,6,1]
[[3,3,6,1],[3,6,1],[6,1],[1],[]]
As you may quickly notice we can zipWith the tail of tails list which is [[3,6,1],[6,1],[1],[]], with the given original list by applying a function to check if all item are different. This function could be a list comprehension or simply the all :: Foldable t => (a -> Bool) -> t a -> Bool function. The thing is, I would like to short circuit zipWith so that once i meet the first dupe let's just stop zipWith doing wasteful work by checking the rest. For this purpose i can use the monadic version of zipWith, namely zipWithM :: Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c] which lives in Control.Monad package. The reason being, from it's type signature we understand that it shall stop calculating any further when it accounts for a Nothing or Left whatever in the middle if my monad happens to be Maybe or Either.
Oh..! In Haskell I also love to use the bool :: a -> a -> Bool -> a function instead of if and then. bool is the ternary operation of Haskell which goes like
bool "work time" "coffee break" isCoffeeTime
The negative choice is on the left and the positive one is on the right where isCoffeeTime :: Bool is a function to return True if it is coffee time. Very composable as well.. so cool..!
So since we now have all the background knowledge we may proceed with the code
import Control.Monad (zipWithM)
import Data.List (tails)
import Data.Bool (bool)
anyDupe :: Eq a => [a] -> Either a [a]
anyDupe xs = zipWithM f xs ts
where ts = tail $ tails xs
f = \x t -> bool (Left x) (Right x) $ all (x /=) t
*Main> anyDupe [1,2,3,4,5]
Right [1,2,3,4,5] -- no dupes so we get the `Right` with the original list
*Main> anyDupe [3,3,6,1]
Left 3 -- here we have the first duplicate since zipWithM short circuits.
*Main> anyDupe $ 10^7:[1..10^7]
Left 10000000 -- wow zipWithM worked and returned reasonably fast.
But again.. as i said, this is still a naive approach because theoretically we are doing n(n+1)/2 operations. Yes zipWithM cuts redundancy down greatly if the first met dupe is close to the head but still this algorithm is O(n^2).
I believe it would be best to use the heavenly sort algorithm of Haskell (which is not merge sort as we know it by the way) in this particular case.
Now the algorithm award goes to -> drum roll here -> sort and fold -> applause. Sorry no grouping.
So now... once again we will use a monadic trick to utilize short circuits. We will use foldM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b. This, when used with Either monad also allows us to return a more meaningful result. OK lets do it. Any Left n means n is the first dupe and no more calculations while any Right _ means there are no dupes.
import Control.Monad (foldM)
import Data.List (sort)
import Data.Bool (bool)
anyDupe' :: (Eq a, Ord a, Enum a) => [a] -> Either a a
anyDupe' xs = foldM f i $ sort xs
where i = succ $ head xs -- prevent the initial value to be equal with the value at the head
f = \b a -> bool (Left a) (Right a) (a /= b)
*Main> anyDupe' [1,2,3,4,5]
Right 5
*Main> anyDupe' [3,3,6,1]
Left 3
*Main> anyDupe' $ 1:[10^7,(10^7-1)..1]
Left 1
(2.97 secs, 1,040,110,448 bytes)
*Main> anyDupe $ 1:[10^7,(10^7-1)..1]
Left 1
(2.94 secs, 1,440,112,888 bytes)
*Main> anyDupe' $ [1..10^7]++[10^7]
Left 10000000
(5.71 secs, 3,600,116,808 bytes) -- winner by far
*Main> anyDupe $ [1..10^7]++[10^7] -- don't try at home, it's waste of energy
In real world scenarios anyDupe' should always be the winner.
Related
When given a list [x0, x1, x2, . . . , xn−1], the function
should return the list [y0, y1, y2, . . . , yn−1] where y0 = x0, y1 = x0 + x1, ...
So if you had [1,2,3] as input, you would get [1,3,6] as output
I don't completely understand foldr, so maybe if I could get some help in trying to figure out how to change that last line to get the right answer.
scan :: [Integer] -> [Integer]
scan [] = []
scan [x] = [x]
scan (x:xs) = x : foldr (/y -> y (+) x) 0 (scan xs)
My initial solution (that works) uses the map function.
scan :: [Integer] -> [Integer]
scan [] = []
scan [x] = [x]
scan (x:xs) = x : map (+x) (scan xs)
EDIT, I added this first section to better address your two implementations.
First, addressing your issue with your implementation using foldr, here are a few remarks:
Lambdas start with a backslash in Haskell, not a slash. That's because backslashes kind of look like the lambda greek letter (λ).
Functions named using only special characters, like +, are infix by default. If you use parens around them, it turns them into prefix functions:
$> (+) 1 5
$> 6
The function passed to foldr takes two argument, whereas you're only supplying one in your lambda. If you really want to ignore the second one, you can use a _ instead of binding it to a variable (\x _ -> x).
I think this you're going down a rabbit hole with this implementation. See the discussion below for my take on the right way to tackle this issue.
Note: It is possible to implement map using foldr (source), that's one way you could use foldr in your working (second) implementation.
Implementing this with foldr is not optimal, since it folds, as the name implies, from the right:
foldr1 (+) [1..5]
--is equivalent to:
(1+(2+(3+(4+5))))
As you can see, the summing operation is done starting from the tail of the list, which is not what you're looking for. To make this work, you would have to "cheat", and reverse your list twice, once before folding it and once after:
scan = tail . reverse . foldr step [0] . reverse where
step e acc#(a:_) = (e + a) : acc
You can make this better using a left fold, which folds from the left:
foldl1 (+) [1..5]
--is equivalent to:
((((1+2)+3)+4)+5)
This, however, still isn't ideal, because to keep the order of elements in your accumulator the same, you would have to use the ++ function, which amounts to quadratic time complexity in such a function. A compromise is to use the : function, but then you still have to reverse your accumulator list after the fold, which is only linear complexity:
scan' :: [Integer] -> [Integer]
scan' = tail . reverse . foldl step [0] where
step acc#(a:_) e = (e + a) : acc
This still isn't very good, since the reverse adds an extra computation. The ideal solution would therefore be to use scanl1, which, as a bonus, doesn't require you to give a starting value ([0] in the examples above):
scan'' :: [Integer] -> [Integer]
scan'' = scanl1 (+)
scanl1 is implemented in terms of scanl, which is defined roughly like this:
scanl f init list = init : (case list of
[] -> []
x:xs -> scanl f (f init x) xs)
You can therefore simply do:
$> scanl1 (+) [1..3]
$> [1,3,6]
As a final note, your scan function is unnecessarily specialized to Integer, as it only requires a Num constraint:
scan :: Num a => [a] -> [a]
This might even lead to an increase in performance, but that's where my abilities end, so I won't go any further :)
Here is the expected input/output:
repeated "Mississippi" == "ips"
repeated [1,2,3,4,2,5,6,7,1] == [1,2]
repeated " " == " "
And here is my code so far:
repeated :: String -> String
repeated "" = ""
repeated x = group $ sort x
I know that the last part of the code doesn't work. I was thinking to sort the list then group it, then I wanted to make a filter on the list of list which are greater than 1, or something like that.
Your code already does half of the job
> group $ sort "Mississippi"
["M","iiii","pp","ssss"]
You said you want to filter out the non-duplicates. Let's define a predicate which identifies the lists having at least two elements:
atLeastTwo :: [a] -> Bool
atLeastTwo (_:_:_) = True
atLeastTwo _ = False
Using this:
> filter atLeastTwo . group $ sort "Mississippi"
["iiii","pp","ssss"]
Good. Now, we need to take only the first element from such lists. Since the lists are non-empty, we can use head safely:
> map head . filter atLeastTwo . group $ sort "Mississippi"
"ips"
Alternatively, we could replace the filter with filter (\xs -> length xs >= 2) but this would be less efficient.
Yet another option is to use a list comprehension
> [ x | (x:_y:_) <- group $ sort "Mississippi" ]
"ips"
This pattern matches on the lists starting with x and having at least another element _y, combining the filter with taking the head.
Okay, good start. One immediate problem is that the specification requires the function to work on lists of numbers, but you define it for strings. The list must be sorted, so its elements must have the typeclass Ord. Therefore, let’s fix the type signature:
repeated :: Ord a => [a] -> [a]
After calling sort and group, you will have a list of lists, [[a]]. Let’s take your idea of using filter. That works. Your predicate should, as you said, check the length of each list in the list, then compare that length to 1.
Filtering a list of lists gives you a subset, which is another list of lists, of type [[a]]. You need to flatten this list. What you want to do is map each entry in the list of lists to one of its elements. For example, the first. There’s a function in the Prelude to do that.
So, you might fill in the following skeleton:
module Repeated (repeated) where
import Data.List (group, sort)
repeated :: Ord a => [a] -> [a]
repeated = map _
. filter (\x -> _)
. group
. sort
I’ve written this in point-free style with the filtering predicate as a lambda expression, but many other ways to write this are equally good. Find one that you like! (For example, you could also write the filter predicate in point-free style, as a composition of two functions: a comparison on the result of length.)
When you try to compile this, the compiler will tell you that there are two typed holes, the _ entries to the right of the equal signs. It will also tell you the type of the holes. The first hole needs a function that takes a list and gives you back a single element. The second hole needs a Boolean expression using x. Fill these in correctly, and your program will work.
Here's some other approaches, to evaluate #chepner's comment on the solution using group $ sort. (Those solutions look simpler, because some of the complexity is hidden in the library routines.)
While it's true that sorting is O(n lg n), ...
It's not just the sorting but especially the group: that uses span, and both of them build and destroy temporary lists. I.e. they do this:
a linear traversal of an unsorted list will require some other data structure to keep track of all possible duplicates, and lookups in each will add to the space complexity at the very least. While carefully chosen data structures could be used to maintain an overall O(n) running time, the constant would probably make the algorithm slower in practice than the O(n lg n) solution, ...
group/span adds considerably to that complexity, so O(n lg n) is not a correct measure.
while greatly complicating the implementation.
The following all traverse the input list just once. Yes they build auxiliary lists. (Probably a Set would give better performance/quicker lookup.) They maybe look more complex, but to compare apples with apples look also at the code for group/span.
repeated2, repeated3, repeated4 :: Ord a => [a] -> [a]
repeated2/inserter2 builds an auxiliary list of pairs [(a, Bool)], in which the Bool is True if the a appears more than once, False if only once so far.
repeated2 xs = sort $ map fst $ filter snd $ foldr inserter2 [] xs
inserter2 :: Ord a => a -> [(a, Bool)] -> [(a, Bool)]
inserter2 x [] = [(x, False)]
inserter2 x (xb#(x', _): xs)
| x == x' = (x', True): xs
| otherwise = xb: inserter2 x xs
repeated3/inserter3 builds an auxiliary list of pairs [(a, Int)], in which the Int counts how many of the a appear. The aux list is sorted anyway, just for the heck of it.
repeated3 xs = map fst $ filter ((> 1).snd) $ foldr inserter3 [] xs
inserter3 :: Ord a => a -> [(a, Int)] -> [(a, Int)]
inserter3 x [] = [(x, 1)]
inserter3 x xss#(xc#(x', c): xs) = case x `compare` x' of
{ LT -> ((x, 1): xss)
; EQ -> ((x', c+1): xs)
; GT -> (xc: inserter3 x xs)
}
repeated4/go4 builds an output list of elements known to repeat. It maintains an intermediate list of elements met once (so far) as it traverses the input list. If it meets a repeat: it adds that element to the output list; deletes it from the intermediate list; filters that element out of the tail of the input list.
repeated4 xs = sort $ go4 [] [] xs
go4 :: Ord a => [a] -> [a] -> [a] -> [a]
go4 repeats _ [] = repeats
go4 repeats onces (x: xs) = case findUpd x onces of
{ (True, oncesU) -> go4 (x: repeats) oncesU (filter (/= x) xs)
; (False, oncesU) -> go4 repeats oncesU xs
}
findUpd :: Ord a => a -> [a] -> (Bool, [a])
findUpd x [] = (False, [x])
findUpd x (x': os) | x == x' = (True, os) -- i.e. x' removed
| otherwise =
let (b, os') = findUpd x os in (b, x': os')
(That last bit of list-fiddling in findUpd is very similar to span.)
Working on a sudoku inspired assignment and I need to implement a function that checks if a Block Cell has no repeated elements in it (to check if its a valid solution to the puzzle).
okBlock :: Block Cell -> Bool
okBlock b = okList $ filter (/= Nothing) b
where
okList :: [a]-> Bool
okList list
| (length list) == (length (nub list)) = True
| otherwise = False
Block a = [a]
Cell = [Maybe Int]
Haskell complains saying No instance for (Eq a) arising from a use of "==" Possible fix: add (Eq a) to the context of the type signature for okList...
Adding Eq a to the type signature does not help. I have tried the function in the terminal and it works fine for for lists, and for lists of lists (i.e the type I am feeding it in the function).
What am I missing here?
Well you can only filter out duplicates, if there is a way to check whether two values are duplicates. If we look at the type signature for nub, we see:
nub :: Eq a => [a] -> [a]
So that means that in order to filter out duplicates in a list of as, we need a to be an instance of the Eq class. We can thus simply forward the type constraint further in the signatures of the functions:
okBlock :: Block Cell -> Bool
okBlock b = okList $ filter (/= Nothing) b
where
okList :: Eq => [a] -> Bool
okList list
| (length list) == (length (nub list)) = True
| otherwise = False
We do not need to specify that Cell is an instance of Eq because:
Int is an instance of Eq;
if a is an instance of Eq, so is Maybe a, so Maybe Int is an instance of Eq; and
if a is an instance of Eq, so is [a], so [Maybe Int] is an instance of Eq.
That being said we can do some syntactical improvements of the code:
there is no need to work with guards if you simply return the result of the guard True and False, and
you can use an eta reduction and omit the b in okBlock.
you don't need parentheses around function application (unless to feed to result straight to another, non-infix function).
This gives us:
okBlock :: Block Cell -> Bool
okBlock = okList . filter (/= Nothing)
where
okList :: Eq => [a] -> Bool
okList list = length list == length (nub list)
A final note is that usually you do not have to specify a type signature. In that case Haskell will aim to dervice the most generic type signature. So you can write:
okBlock = okList . filter (/= Nothing)
where
okList list = length list == length (nub list)
Now okBlock will have type:
Prelude Data.List> :t okBlock
okBlock :: Eq a => [Maybe a] -> Bool
Three points that are too big to make in a comment.
nub is horribly slow
nub takes O(n^2) time to process a list of length n. Unless you know the list is very short, this is the wrong function to use to remove duplicates from a list. Adding a bit more information about what sort of thing you're working with allows more efficient nubbing. The simplest, and probably most general, approach that isn't absolutely wretched is to use an Ord constraint:
import qualified Data.Set as S
nubOrd :: Ord a => [a] -> [a]
nubOrd = go S.empty where
go _seen [] = []
go seen (a : as)
| a `S.member` seen = go seen as
| otherwise = go (S.insert a seen) as
length is wasteful
Suppose I write
sameLength :: [a] -> [b] -> Bool
sameLength xs ys = length xs == length ys
(which uses the approach you did). Now imagine I calculate
sameLength [1..16] [1..2^100]
How long will that take? Calculating length [1..16] will take nanoseconds. Calculating length [1..2^100] will probably take billions of years using current hardware. Whoops. What's the right way? Pattern match!
sameLength [] [] = True
sameLength (_ : xs) (_ : ys) = sameLength xs ys
sameLength _ _ = False
Nubbing isn't the right solution to this problem
Suppose I ask noDuplicates (1 : [1,2..]). Obviously, there's a duplicate, right at the beginning. But if I use sameLength and nub to check, I will never get an answer. It will keep building the nubbed list and comparing it to the original list until the seen becomes so large it exhausts your computer's memory. How can you fix that? By directly calculating what you need:
noDuplicates = go S.empty where
go _seen [] = True
go seen (x : xs)
| x `S.member` seen = False
| otherwise = go (S.insert x seen) xs
Now the program will conclude that there's a duplicate the moment it sees the second 1.
Here is an sample problem I'm working upon:
Example Input: test [4, 1, 5, 6] 6 returns 5
I'm solving this using this function:
test :: [Int] -> Int -> Int
test [] _ = 0
test (x:xs) time = if (time - x) < 0
then x
else test xs $ time - x
Any better way to solve this function (probably using any inbuilt higher order function) ?
How about
test xs time = maybe 0 id . fmap snd . find ((>time) . fst) $ zip sums xs
where sums = scanl1 (+) xs
or equivalently with that sugary list comprehension
test xs time = headDef 0 $ [v | (s, v) <- zip sums xs, s > time]
where sums = scanl1 (+) xs
headDef is provided by safe. It's trivial to implement (f _ (x:_) = x; f x _ = x) but the safe package has loads of useful functions like these so it's good to check out.
Which sums the list up to each point and finds the first occurence greater than time. scanl is a useful function that behaves like foldl but keeps intermediate results and zip zips two lists into a list of tuples. Then we just use fmap and maybe to manipulate the Maybe (Integer, Integer) to get our result.
This defaults to 0 like yours but I like the version that simply goes to Maybe Integer better from a user point of view, to get this simply remove the maybe 0 id.
You might like scanl and its close relative, scanl1. For example:
test_ xs time = [curr | (curr, tot) <- zip xs (scanl1 (+) xs), tot > time]
This finds all the places where the running sum is greater than time. Then you can pick the first one (or 0) like this:
safeHead def xs = head (xs ++ [def])
test xs time = safeHead 0 (test_ xs time)
This is verbose, and I don't necessarily recommend writing such a simple function like this (IMO the pattern matching & recursion is plenty clear). But, here's a pretty declarative pipeline:
import Control.Error
import Data.List
deadline :: (Num a, Ord a) => a -> [a] -> a
deadline time = fromMaybe 0 . findDeadline time
findDeadline :: (Num a, Ord a) => a -> [a] -> Maybe a
findDeadline time xs = decayWithDifferences time xs
>>= findIndex (< 0)
>>= atMay xs
decayWithDifferences :: Num b => b -> [b] -> Maybe [b]
decayWithDifferences time = tailMay . scanl (-) time
-- > deadline 6 [4, 1, 5, 6]
-- 5
This documents the code a bit and in principle lets you test a little better, though IMO these functions fit more-or-less into the 'obviously correct' category.
You can verify that it matches your implementation:
import Test.QuickCheck
prop_equality :: [Int] -> Int -> Bool
prop_equality time xs = test xs time == deadline time xs
-- > quickCheck prop_equality
-- +++ OK, passed 100 tests.
In this particular case zipping suggested by others in not quite necessary:
test xs time = head $ [y-x | (x:y:_) <- tails $ scanl1 (+) $ 0:xs, y > time]++[0]
Here scanl1 will produce a list of rolling sums of the list xs, starting it with 0. Therefore, tails will produce a list with at least one list having two elements for non-empty xs. Pattern-matching (x:y:_) extracts two elements from each tail of rolling sums, so in effect it enumerates pairs of neighbouring elements in the list of rolling sums. Filtering on the condition, we reconstruct a part of the list that starts with the first element that produces a rolling sum greater than time. Then use headDef 0 as suggested before, or append a [0], so that head always returns something.
If you want to retain readability, I would just stick with your current solution. It's easy to understand, and isn't doing anything wrong.
Just because you can make it into a one line scan map fold mutant doesn't mean that you should!
Say I have any list like this:
[4,5,6,7,1,2,3,4,5,6,1,2]
I need a Haskell function that will transform this list into a list of lists which are composed of the segments of the original list which form a series in ascending order. So the result should look like this:
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
Any suggestions?
You can do this by resorting to manual recursion, but I like to believe Haskell is a more evolved language. Let's see if we can develop a solution that uses existing recursion strategies. First some preliminaries.
{-# LANGUAGE NoMonomorphismRestriction #-}
-- because who wants to write type signatures, amirite?
import Data.List.Split -- from package split on Hackage
Step one is to observe that we want to split the list based on a criteria that looks at two elements of the list at once. So we'll need a new list with elements representing a "previous" and "next" value. There's a very standard trick for this:
previousAndNext xs = zip xs (drop 1 xs)
However, for our purposes, this won't quite work: this function always outputs a list that's shorter than the input, and we will always want a list of the same length as the input (and in particular we want some output even when the input is a list of length one). So we'll modify the standard trick just a bit with a "null terminator".
pan xs = zip xs (map Just (drop 1 xs) ++ [Nothing])
Now we're going to look through this list for places where the previous element is bigger than the next element (or the next element doesn't exist). Let's write a predicate that does that check.
bigger (x, y) = maybe False (x >) y
Now let's write the function that actually does the split. Our "delimiters" will be values that satisfy bigger; and we never want to throw them away, so let's keep them.
ascendingTuples = split . keepDelimsR $ whenElt bigger
The final step is just to throw together the bit that constructs the tuples, the bit that splits the tuples, and a last bit of munging to throw away the bits of the tuples we don't care about:
ascending = map (map fst) . ascendingTuples . pan
Let's try it out in ghci:
*Main> ascending [4,5,6,7,1,2,3,4,5,6,1,2]
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
*Main> ascending [7,6..1]
[[7],[6],[5],[4],[3],[2],[1]]
*Main> ascending []
[[]]
*Main> ascending [1]
[[1]]
P.S. In the current release of split, keepDelimsR is slightly stricter than it needs to be, and as a result ascending currently doesn't work with infinite lists. I've submitted a patch that makes it lazier, though.
ascend :: Ord a => [a] -> [[a]]
ascend xs = foldr f [] xs
where
f a [] = [[a]]
f a xs'#(y:ys) | a < head y = (a:y):ys
| otherwise = [a]:xs'
In ghci
*Main> ascend [4,5,6,7,1,2,3,4,5,6,1,2]
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
This problem is a natural fit for a paramorphism-based solution. Having (as defined in that post)
para :: (a -> [a] -> b -> b) -> b -> [a] -> b
foldr :: (a -> b -> b) -> b -> [a] -> b
para c n (x : xs) = c x xs (para c n xs)
foldr c n (x : xs) = c x (foldr c n xs)
para c n [] = n
foldr c n [] = n
we can write
partition_asc xs = para c [] xs where
c x (y:_) ~(a:b) | x<y = (x:a):b
c x _ r = [x]:r
Trivial, since the abstraction fits.
BTW they have two kinds of map in Common Lisp - mapcar
(processing elements of an input list one by one)
and maplist (processing "tails" of a list). With this idea we get
import Data.List (tails)
partition_asc2 xs = foldr c [] . init . tails $ xs where
c (x:y:_) ~(a:b) | x<y = (x:a):b
c (x:_) r = [x]:r
Lazy patterns in both versions make it work with infinite input lists
in a productive manner (as first shown in Daniel Fischer's answer).
update 2020-05-08: not so trivial after all. Both head . head . partition_asc $ [4] ++ undefined and the same for partition_asc2 fail with *** Exception: Prelude.undefined. The combining function g forces the next element y prematurely. It needs to be more carefully written to be productive right away before ever looking at the next element, as e.g. for the second version,
partition_asc2' xs = foldr c [] . init . tails $ xs where
c (x:ys) r#(~(a:b)) = (x:g):gs
where
(g,gs) | not (null ys)
&& x < head ys = (a,b)
| otherwise = ([],r)
(again, as first shown in Daniel's answer).
You can use a right fold to break up the list at down-steps:
foldr foo [] xs
where
foo x yss = (x:zs) : ws
where
(zs, ws) = case yss of
(ys#(y:_)) : rest
| x < y -> (ys,rest)
| otherwise -> ([],yss)
_ -> ([],[])
(It's a bit complicated in order to have the combining function lazy in the second argument, so that it works well for infinite lists too.)
One other way of approaching this task (which, in fact lays the fundamentals of a very efficient sorting algorithm) is using the Continuation Passing Style a.k.a CPS which, in this particular case applied to folding from right; foldr.
As is, this answer would only chunk up the ascending chunks however, it would be nice to chunk up the descending ones at the same time... preferably in reverse order all in O(n) which would leave us with only binary merging of the obtained chunks for a perfectly sorted output. Yet that's another answer for another question.
chunks :: Ord a => [a] -> [[a]]
chunks xs = foldr go return xs $ []
where
go :: Ord a => a -> ([a] -> [[a]]) -> ([a] -> [[a]])
go c f = \ps -> let (r:rs) = f [c]
in case ps of
[] -> r:rs
[p] -> if c > p then (p:r):rs else [p]:(r:rs)
*Main> chunks [4,5,6,7,1,2,3,4,5,6,1,2]
[[4,5,6,7],[1,2,3,4,5,6],[1,2]]
*Main> chunks [4,5,6,7,1,2,3,4,5,4,3,2,6,1,2]
[[4,5,6,7],[1,2,3,4,5],[4],[3],[2,6],[1,2]]
In the above code c stands for current and p is for previous and again, remember we are folding from right so previous, is actually the next item to process.