Split a list into non-empty sub-lists in Haskell

Question

I have to split the given list into non-empty sub-lists each of which is either in strictly ascending order, in strictly descending order, or contains all equal elements. For example, [5,6,7,2,1,1,1] should become [[5,6,7],[2,1],[1,1]].

Here is what I have done so far:

splitSort :: Ord a => [a] -> [[a]] 
splitSort ns = foldr k [] ns
  where
    k a []  = [[a]]
    k a ns'@(y:ys) | a <= head y = (a:y):ys
                   | otherwise = [a]:ns'

I think I am quite close but when I use it it outputs [[5,6,7],[2],[1,1,1]] instead of [[5,6,7],[2,1],[1,1]].

Answer 1

Here is a kinda ugly solution, with three reverse in one line of code :).

addElement :: Ord a => a -> [[a]] -> [[a]]
addElement a []  = [[a]]
addElement a (x:xss) = case x of
  (x1:x2:xs) 
    | any (check a x1 x2) [(==),(<),(>)] -> (a:x1:x2:xs):xss
    | otherwise -> [a]:(x:xss)
  _  -> (a:x):xss
  where 
    check x1 x2 x3 op = (x1 `op` x2) && (x2 `op` x3) 

splitSort xs = reverse $ map reverse $ foldr addElement [] (reverse xs)

You can possibly get rid of all the reversing if you modify addElement a bit.

EDIT: Here is a less reversing version (even works for infinite lists):

splitSort2 []         = []
splitSort2 [x]        = [[x]]
splitSort2 (x:y:xys)  = (x:y:map snd here):splitSort2 (map snd later)
  where 
    (here,later) = span ((==c) . uncurry compare) (zip (y:xys) xys)
    c            = compare x y  

EDIT 2: Finally, here is a solution based on a single decorating/undecorating, that avoids comparing any two values more than once and is probably a lot more efficient.

splitSort xs = go (decorate xs) where
  decorate :: Ord a => [a] -> [(Ordering,a)]
  decorate xs = zipWith (\x y -> (compare x y,y)) (undefined:xs) xs

  go :: [(Ordering,a)] -> [[a]]
  go ((_,x):(c,y):xys)  = let (here, later) = span ((==c) . fst) xys in 
                              (x : y : map snd here) : go later
  go xs = map (return . snd) xs -- Deal with both base cases

Answer 2

Every ordered prefix is already in some order, and you don't care in which, as long as it is the longest:

import Data.List (group, unfoldr)

foo :: Ord t => [t] -> [[t]]
foo = unfoldr f
  where
  f []  = Nothing
  f [x] = Just ([x], [])
  f xs  = Just $ splitAt (length g + 1) xs
            where 
            (g : _) = group $ zipWith compare xs (tail xs)

---

length can be fused in to make the splitAt count in unary essentially, and thus not be as strict (unnecessarily, as Jonas Duregård rightly commented):

  ....
  f xs  = Just $ foldr c z g xs
            where 
            (g : _) = group $ zipWith compare xs (tail xs)
            c _ r (x:xs) = let { (a,b) = r xs } in (x:a, b)
            z     (x:xs) = ([x], xs)

Answer 3

The initial try turned out to be lengthy probably inefficient but i will keep it striked for the sake of integrity with the comments. You best just skip to the end for the answer.

Nice question... but turns out to be a little hard candy. My approach is in segments, those of each i will explain;

import Data.List (groupBy)

splitSort :: Ord a => [a] -> [[a]]
splitSort (x:xs) = (:) <$> (x :) . head <*> tail $ interim
                   where
                   pattern = zipWith compare <$> init <*> tail
                   tuples  = zipWith (,) <$> tail <*> pattern
                   groups  = groupBy (\p c -> snd p == snd c) . tuples $ (x:xs)
                   interim = groups >>= return . map fst

*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]

• The pattern function (zipWith compare <$> init <*> tail) is of type Ord a => [a] -> [Ordering] when fed with [5,6,7,2,1,1,1] compares the init of it by the tail of it by zipWith. So the result would be [LT,LT,GT,GT,EQ,EQ]. This is the pattern we need.
• The tuples function will take the tail of our list and will tuple up it's elements with the corresponding elements from the result of pattern. So we will end up with something like [(6,LT),(7,LT),(2,GT),(1,GT),(1,EQ),(1,EQ)].
• The groups function utilizes Data.List.groupBy over the second items of the tuples and generates the required sublists such as [[(6,LT),(7,LT)],[(2,GT),(1,GT)],[(1,EQ),(1,EQ)]]
• Interim is where we monadically get rid of the Ordering type values and tuples. The result of interim is [[6,7],[2,1],[1,1]].
• Finally at the main function body (:) <$> (x :) . head <*> tail $ interim appends the first item of our list (x) to the sublist at head (it has to be there whatever the case) and gloriously present the solution.

Edit: So investigating the [0,1,0,1] resulting [[0,1],[0],[1]] problem that @Jonas Duregård discovered, we can conclude that in the result there shall be no sub lists with a length of 1 except for the last one when singled out. I mean for an input like [0,1,0,1,0,1,0] the above code produces [[0,1],[0],[1],[0],[1],[0]] while it should [[0,1],[0,1],[0,1],[0]]. So I believe adding a squeeze function at the very last stage should correct the logic.

import Data.List (groupBy)

splitSort :: Ord a => [a] -> [[a]]
splitSort []     = []
splitSort [x]    = [[x]]
splitSort (x:xs) = squeeze $ (:) <$> (x :) . head <*> tail $ interim
                   where
                   pattern = zipWith compare <$> init <*> tail
                   tuples  = zipWith (,) <$> tail <*> pattern
                   groups  = groupBy (\p c -> snd p == snd c) $ tuples (x:xs)
                   interim = groups >>= return . map fst

                   squeeze []           = []
                   squeeze [y]          = [y]
                   squeeze ([n]:[m]:ys) = [n,m] : squeeze ys
                   squeeze ([n]:(m1:m2:ms):ys) | compare n m1 == compare m1 m2 = (n:m1:m2:ms) : squeeze ys
                                               | otherwise                     = [n] : (m1:m2:ms) : squeeze ys
                   squeeze (y:ys)       = y : squeeze s

*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]

Yes; as you will also agree the code has turned out to be a little too lengthy and possibly not so efficient.

The Answer: I have to trust the back of my head when it keeps telling me i am not on the right track. Sometimes, like in this case, the problem reduces down to a single if then else instruction, much simpler than i had initially anticipated.

runner :: Ord a => Maybe Ordering -> [a] -> [[a]]
runner _       []  = []
runner _       [p] = [[p]]
runner mo (p:q:rs) = let mo'    = Just (compare p q)
                         (s:ss) = runner mo' (q:rs)
                     in if mo == mo' || mo == Nothing then (p:s):ss
                                                      else [p] : runner Nothing (q:rs)
splitSort :: Ord a => [a] -> [[a]]
splitSort = runner Nothing

My test cases

*Main> splitSort [0,1, 0, 1, 0, 1, 0]
[[0,1],[0,1],[0,1],[0]]
*Main> splitSort [5,6,7,2,1,1,1]
[[5,6,7],[2,1],[1,1]]
*Main> splitSort [0,0,1,0,-1]
[[0,0],[1,0,-1]]
*Main> splitSort [1,2,3,5,2,0,0,0,-1,-1,0]
[[1,2,3,5],[2,0],[0,0],[-1,-1],[0]]