Is there a non-recursive way to write this "paginate" function? - haskell

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

Related

Why `data` cause an infinite loop while `newtype` not

I am learning Arrow following the tutorial programming with arrows. I've typed the following code according to the paper except that the SF is defined by data, not by newtype as in the paper (actually, I made this change by chance, since I typed the code from memory):
import Control.Category
import Control.Arrow
import Prelude hiding (id, (.))
data SF a b = SF { runSF :: [a] -> [b] } -- this is the change, using data instead of newtype as in the paper
-- The folowing code is the same as in the paper
instance Category SF where
id = SF $ \x -> x
(SF f) . (SF g) = SF $ \x -> f (g x)
instance Arrow SF where
arr f = SF $ map f
first (SF f) = SF $ unzip >>> first f >>> uncurry zip
instance ArrowChoice SF where
left (SF f) = SF $ \xs -> combine xs (f [y | Left y <- xs])
where
combine (Left _ : ys) (z:zs) = Left z : combine ys zs
combine (Right y : ys) zs = Right y : combine ys zs
combine [] _ = []
delay :: a -> SF a a
delay x = SF $ init . (x:)
mapA :: ArrowChoice a => a b c -> a [b] [c]
mapA f = arr listcase >>>
arr (const []) ||| (f *** mapA f >>> arr (uncurry (:)))
listcase :: [a] -> Either () (a, [a])
listcase [] = Left ()
listcase (x:xs) = Right (x, xs)
When I load the file in ghci and execute runSF (mapA (delay 0)) [[1,2,3],[4,5,6]], it triggers an infinit loop and runs out of memory finally. If I change data back to newtype, everything is OK. The same problem happens in ghc 8.0.2, 8.2.2 and 8.6.3.
The same problem also exists even I compile the code into an executable.
I have thought the difference between data and newtype, when defining a data structure with only one field, is the runtime cost. But this problem seems to imply more difference between them. Or there may be something that I haven't noticed about the Arrow type-class.
Can anyone have any ideas? Thanks very much!
Let's look at this example.
data A = A [Int]
deriving (Show)
cons :: Int -> A -> A
cons x (A xs) = A (x:xs)
ones :: A
ones = cons 1 ones
We would expect that ones should be A [1,1,1,1...], because all we have done is wrap a list in a data constructor. But we would be wrong. Recall that pattern matches are strict for data constructors. That is, cons 1 undefined = undefined rather than A (1 : undefined). So when we try to evaluate ones, cons pattern matches on its second argument, which causes us to evaluate ones... we have a problem.
newtypes don't do this. At runtime newtype constructors are invisible, so it's as if we had written the equivalent program on plain lists
cons :: Int -> [Int] -> [Int]
cons x ys = x:ys
ones = cons 1 ones
which is perfectly productive, since when we try to evaluate ones, there is a : constructor between us and the next evaluation of ones.
You can get back the newtype semantics by making your data constructor pattern matches lazy:
cons x ~(A xs) = A (x:xs)
This is the problem with your code (I have run into this exact problem doing this exact thing). There are a few reasons data pattern matches are strict by default; the most compelling one I see is that pattern matching would otherwise be impossible if the type had more than one constructor. There is also a small runtime overhead to lazy pattern matching in order to fix some subtle GC leaks; details linked in the comments.

Haskell - How to traverse through a list and reverse elements

I am having trouble locating documentation on simple operations in Haskell.
I have a list of lists (:: [[a]]) and I need to reverse all of the element lists x where length x >= 2.
So far I haven't found anything on:
How to traverse the lists
How would I find the length of the element. There is the length function I can use, but I haven't got an idea how to use it.
I did find the reverse function for lists, though I had trouble finding it.
If any help on those individual implementation, it would be greatly appreciated. I can piece them together.
I need to reverse all of the element lists x where length x >= 2
You can totally ignore the length x >= 2 part, since if the length of a list is 0 or 1, reversing it has no effect: there's no way to tell whether you reversed it or not, so you might as well just reverse all lists, for uniformity.
Given that, this is super simple: you just need to map reverse over the list of lists, reversing each one in turn:
reverseEach :: [[a]] -> [[a]]
reverseEach = map reverse
> reverseEach [[1,2,3],[4],[5,6,7,8]]
[[3,2,1],[4],[8,7,6,5]]
And as other answers suggest, you can afford to generalize a little bit:
reverseEach :: Functor f => f [a] -> f [a]
reverseEach = fmap reverse
> reverseEach [[1,2,3],[4],[5,6,7,8]]
[[3,2,1],[4],[8,7,6,5]]
how to traverse the lists.
There are several sequence functions, from the more basic fmap, which maps a single function over a list, to foldr, which folds a list structure around a binary operation (for summing a list or similar operations) to the sequence/traverse operations, which carry monadic or applicative effects.
How would I find the length of the element. There is the length function I can use, but I haven't got an idea how to use it.
There is a length function; you use it like any other function. length xs, where xs is a list. If you still aren't certain how to do that, I would suggest starting slower with a Haskell tutorial.
And I have this to reverse the list, But i think i have that now.
There is a reverse function. If you don't want to use the built-in one (or if you want to do it yourself for educational purposes), you could build an efficient reverse function with an accumulator.
reverse' :: [a] -> [a]
reverse' xs = doReverse xs []
where doReverse [] ys = ys
doReverse (x:xs) ys = doReverse xs (x:ys)
Solution:
conditionallyReverse :: [[a]] -> [[a]]
ConditionallyReverse listOfLists= fmap f listOfLists
where
f list
| length list >= 2 = reverse x
| otherwise = x
We apply the function f to each element of the listOfLists by supplying f as the first argument to fmap and the listOfLists as the second argument. The function f transforms a list based on the condition length list >= 2. If the condition holds, the list is reversed, otherwise the original list is returned.
Absurd over-generalization:
Every Traversable instance supports a horrible hack implementing reverse. There may be a cleaner or more efficient way to do this; I'm not sure.
module Rev where
import Data.Traversable
import Data.Foldable
import Control.Monad.Trans.State.Strict
import Prelude hiding (foldl)
fill :: Traversable t => t b -> [a] -> t a
fill = evalState . traverse go
where
go _ = do
xs <- get
put (drop 1 xs)
return (head xs)
reverseT :: Traversable t => t a -> t a
reverseT xs = fill xs $ foldl (flip (:)) [] xs
reverseAll :: (Functor f, Traversable t) => f (t a) -> f (t a)
reverseAll = fmap reverseT
In terms of folds:
reverse = foldl (\ acc x -> x : acc) []
length = foldl' (\ n _ -> n + 1) 0
map f = foldr (\ x xs -> f x : xs)
letting
mapReverse = map (\ xs -> if length xs >= 2 then reverse xs else xs)
But length is a costly O(n), and reverse [x] = [x]. I would use
map reverse [[1,2,3],[4],[]] == [[3,2,1],[4],[]]
where (map reverse) :: [[a]] -> [[a]]. map reverse isn't basic enough to justify an own name binding.

How to get rid of boxing and unboxing in functional programing?

says that we want to filter out all the odd one in a list.
odd' (i,n) = odd i
unbox (i,n) = n
f :: [Int] -> [Int]
f lst = map unbox $ filter odd' $ zip [1..] lst
*Main> f [1,2,3,4]
[1,3]
it has the unpleasant boxing and unboxing.
can we change the way we think this problem and eliminate boxing and unboxing?
#user3237465 list comprehension is indeed a good way of thinking this sort of problem.
as well as function composition. well, I think we won't get rid of "wrapping the original list to [(index,value)] form and then unwrap it" without writing a special form like #Carsten König provided.
Or have a function that give out one value's index given the list and the value. like filter (odd . getindex) xs
and maybe that's why clojure made it's pattern matching strong enough to get value in complex structure.
you can always rewrite the function if you want - this comes to mind:
odds :: [a] -> [a]
odds (x:_:xs) = x : odds xs
odds [x] = [x]
odds _ = []
aside from this both you don't need odd' and unbox:
odd' is just odd . fst
unbox is just snd
You can write this as
f xs = [x | (i, x) <- zip [0..] xs, even i]
or
f = snd . foldr (\x ~(o, e) -> (e, x : o)) ([], [])
or
import Data.Either
f = lefts . zipWith ($) (cycle [Left, Right])

Nondeterminism for infinite inputs

Using lists to model nondeterminism is problematic if the inputs can take infinitely many values. For example
pairs = [ (a,b) | a <- [0..], b <- [0..] ]
This will return [(0,1),(0,2),(0,3),...] and never get around to showing you any pair whose first element is not 0.
Using the Cantor pairing function to collapse a list of lists into a single list can get around this problem. For example, we can define a bind-like operator that orders its outputs more intelligently by
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor (map f as)
cantor :: [[a]] -> [a]
cantor xs = go 1 xs
where
go _ [] = []
go n xs = hs ++ go (n+1) ts
where
ys = filter (not.null) xs
hs = take n $ map head ys
ts = mapN n tail ys
mapN :: Int -> (a -> a) -> [a] -> [a]
mapN _ _ [] = []
mapN n f xs#(h:t)
| n <= 0 = xs
| otherwise = f h : mapN (n-1) f t
If we now wrap this up as a monad, we can enumerate all possible pairs
newtype Select a = Select { runSelect :: [a] }
instance Monad Select where
return a = Select [a]
Select as >>= f = Select $ as >>>= (runSelect . f)
pairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a,b)
This results in
>> take 15 pairs
[(0,0),(0,1),(1,0),(0,2),(1,1),(2,0),(0,3),(1,2),(2,1),(3,0),(0,4),(1,3),(2,2),(3,1),(4,0)]
which is a much more desirable result. However, if we were to ask for triples instead, the ordering on the outputs isn't as "nice" and it's not even clear to me that all outputs are eventually included --
>> take 15 triples
[(0,0,0),(0,0,1),(1,0,0),(0,1,0),(1,0,1),(2,0,0),(0,0,2),(1,1,0),(2,0,1),(3,0,0),(0,1,1),(1,0,2),(2,1,0),(3,0,1),(4,0,0)]
Note that (2,0,1) appears before (0,1,1) in the ordering -- my intuition says that a good solution to this problem will order the outputs according to some notion of "size", which could be an explicit input to the algorithm, or could be given implicitly (as in this example, where the "size" of an input is its position in the input lists). When combining inputs, the "size" of a combination should be some function (probably the sum) of the size of the inputs.
Is there an elegant solution to this problem that I am missing?
TL;DR: It flattens two dimensions at a time, rather than flattening three at once. You can't tidy this up in the monad because >>= is binary, not ternary etc.
I'll assume you defined
(>>>=) :: [a] -> (a -> [b]) -> [b]
as >>>= f = cantor $ map f as
to interleave the list of lists.
You like that because it goes diagonally:
sums = runSelect $ do
a <- Select [0..]
b <- Select [0..]
return (a+b)
gives
ghci> take 36 sums
[0,1,1,2,2,2,3,3,3,3,4,4,4,4,4,5,5,5,5,5,5,6,6,6,6,6,6,6,7,7,7,7,7,7,7,7]
so it's pleasingly keeping the "sizes" in order, but the pattern appears to be broken for triples, and you doubt completeness, but you needn't. It's doing the same trick, but twice, rather than for all three at once:
triplePairs = runSelect $ do
a <- Select [0..]
b <- Select [0..]
c <- Select [0..]
return $ (a,(b,c))
The second pair is treated as a single source of data, so notice that:
ghci> map fst $ take 36 pairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
ghci> map fst $ take 36 triplePairs
[0,0,1,0,1,2,0,1,2,3,0,1,2,3,4,0,1,2,3,4,5,0,1,2,3,4,5,6,0,1,2,3,4,5,6,7]
and (adding some spaces/newlines for clarity of pattern):
ghci> map snd $ take 36 pairs
[0, 1,0, 2,1,0, 3,2,1,0, 4,3,2,1,0, 5,4,3,2,1,0, 6,5,4,3,2,1,0, 7,6,5,4,3,2,1,0]
ghci> map snd $ take 36 triplePairs
[(0,0), (0,1),(0,0), (1,0),(0,1),(0,0), (0,2),(1,0),(0,1),(0,0),
(1,1),(0,2),(1,0),(0,1),(0,0),
(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0),
(1,2),(0,3),(2,0),(1,1),(0,2),(1,0),(0,1),(0,0)]
so you can see it's using exactly the same pattern. This doesn't preserve total sums and it oughtn't because we're getting to three dimensions by flattening two dimensions first before flattening the third in. The pattern is obscured, but it's just as guaranteed to make it to the end of the list.
Sadly if you want to do three dimensions in a sum-preserving way, you'll have to write cantor2, cantor3 and cantor4 functions, possibly a cantorN function, but you'll have to ditch the monadic interface, which is inherently based on the bracketing of >>=, hence two-at-a-time flattening of dimensions.
import Control.Applicative
import Control.Arrow
data Select a = Select [a]
| Selects [Select a]
instance Functor Select where
fmap f (Select x) = Select $ map f x
fmap f (Selects xss) = Selects $ map (fmap f) xss
instance Applicative Select where
pure = Select . (:[])
Select fs <*> xs = Selects $ map (`fmap`xs) fs
Selects fs <*> xs = Selects $ map (<*>xs) fs
instance Monad Select where
return = pure
Select xs >>= f = Selects $ map f xs
Selects xs >>= f = Selects $ map (>>=f) xs
runSelect :: Select a -> [a]
runSelect = go 1
where go n xs = uncurry (++) . second (go $ n+1) $ splitOff n xs
splitOff n (Select xs) = second Select $ splitAt n xs
splitOff n (Selects sls) = (concat hs, Selects $ tsl ++ rl)
where ((hs, tsl), rl) = first (unzip . map (splitOff n)) $ splitAt n sls
*Select> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; return (a,b) }
[(0,0),(0,1),(1,0),(1,1),(0,2),(1,2),(2,0),(2,1),(2,2),(0,3),(1,3),(2,3),(3,0),(3,1),(3,2)]
*Select> take 15 . runSelect $ do { a<‌-Select [0..]; b<‌-Select [0..]; c<‌-Select [0..]; return (a,b,c) }
[(0,0,0),(0,0,1),(0,1,0),(0,1,1),(1,0,0),(1,0,1),(1,1,0),(1,1,1),(0,0,2),(0,1,2),(0,2,0),(0,2,1),(0,2,2),(1,0,2),(1,1,2)]
Note that this is still not quite Cantor-tuples ((0,1,1) shouldn't come before (1,0,0)), but getting it correct would be possible as well in a similar manner.
A correct multidimentional enumerator could be represented with a temporary state object
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-}
class Space a b where
slice :: a -> ([b], a)
instance Space [a] a where
slice (l:ls) = ([l], ls)
slice [] = ([], [])
instance (Space sp x) => Space ([sp], [sp]) x where
slice (fs, b:bs) = let
ss = map slice (b : fs)
yield = concat $ map fst ss
in (yield, (map snd ss, bs))
Here an N dimensional space is represented by a tuple of lists of N-1 dimensional subspaces that have and haven't been touched by the enumeration.
You can then use the following to produce a well ordered list
enumerate :: (Space sp x) => sp -> [x]
enumerate sp = let (sl, sp') = slice sp
in sl ++ enumerate sp'
Example in Ideone.
The omega package does exactly what you want and guarantees that every element will be eventually visited:
import Control.Applicative
import Control.Monad.Omega
main = print . take 200 . runOmega $
(,,) <$> each [0..] <*> each [0..] <*> each [0..]
Another option would be to use LogicT. It gives more flexibility (if you need) and has operations such as (>>-) that ensure that every combination is eventually encountered.
import Control.Applicative
import Control.Monad
import Control.Monad.Logic
-- | Convert a list into any MonadPlus.
each :: (MonadPlus m) => [a] -> m a
each = msum . map return
-- | A fair variant of '(<*>)` that ensures that both branches are explored.
(<#>) :: (MonadLogic m) => m (a -> b) -> m a -> m b
(<#>) f k = f >>- (\f' -> k >>- (\k' -> return $ f' k'))
infixl 4 <#>
main = print . observeMany 200 $
(,,) <$> each [0..] <#> each [0..] <#> each [0..]

Recursively sort non-contiguous list to list of contiguous lists

I've been trying to learn a bit of functional programming (with Haskell & Erlang) lately and I'm always amazed at the succinct solutions people can come up with when they can think recursively and know the tools.
I want a function to convert a list of sorted, unique, non-contiguous integers into a list of contiguous lists, i.e:
[1,2,3,6,7,8,10,11]
to:
[[1,2,3], [6,7,8], [10,11]
This was the best I could come up with in Haskell (two functions)::
make_ranges :: [[Int]] -> [Int] -> [[Int]]
make_ranges ranges [] = ranges
make_ranges [] (x:xs)
| null xs = [[x]]
| otherwise = make_ranges [[x]] xs
make_ranges ranges (x:xs)
| (last (last ranges)) + 1 == x =
make_ranges ((init ranges) ++ [(last ranges ++ [x])]) xs
| otherwise = make_ranges (ranges ++ [[x]]) xs
rangify :: [Int] -> [[Int]]
rangify lst = make_ranges [] lst
It might be a bit subjective but I'd be interested to see a better, more elegant, solution to this in either Erlang or Haskell (other functional languages too but I might not understand it.) Otherwise, points for just fixing my crappy beginner's Haskell style!
Most straightforward way in my mind is a foldr:
ranges = foldr step []
where step x [] = [[x]]
step x acc#((y:ys):zs) | y == x + 1 = (x:y:ys):zs
| otherwise = [x]:acc
Or, more concisely:
ranges = foldr step []
where step x ((y:ys):zs) | y == x + 1 = (x:y:ys):zs
step x acc = [x]:acc
But wait, there's more!
abstractRanges f = foldr step []
where step x ((y:ys):zs) | f x y = (x:y:ys):zs
step x acc = [x]:acc
ranges = abstractRanges (\x y -> y == x + 1)
powerRanges = abstractRanges (\x y -> y == x*x) -- mighty morphin
By turning the guard function into a parameter, you can group more interesting things than just +1 sequences.
*Main> powerRanges [1,1,1,2,4,16,3,9,81,5,25]
[[1,1,1],[2,4,16],[3,9,81],[5,25]]
The utility of this particular function is questionable...but fun!
I can't believe I got the shortest solution. I know this is no code golf, but I think it is still quite readable:
import GHC.Exts
range xs = map (map fst) $ groupWith snd $ zipWith (\a b -> (a, a-b)) xs [0..]
or pointfree
range = map (map snd) . groupWith fst . zipWith (\a b -> (b-a, b)) [0..]
BTW, groupWith snd can be replaced with groupBy (\a b -> snd a == snd b) if you prefer Data.List over GHC.Exts
[Edit]
BTW: Is there a nicer way to get rid of the lambda (\a b -> (b-a, b)) than (curry $ (,) <$> ((-) <$> snd <*> fst) <*> snd) ?
[Edit 2]
Yeah, I forgot (,) is a functor. So here is the obfuscated version:
range = map (map fst) . groupWith snd . (flip $ zipWith $ curry $ fmap <$> (-).fst <*> id) [0..]
Suggestions are welcome...
import Data.List (groupBy)
ranges xs = (map.map) snd
. groupBy (const fst)
. zip (True : zipWith ((==) . succ) xs (tail xs))
$ xs
As to how to come up with such a thing: I started with the zipWith f xs (tail xs), which is a common idiom when you want to do something on consecutive elements of a list. Likewise is zipping up a list with information about the list, and then acting (groupBy) upon it. The rest is plumbing.
Then, of course, you can feed it through #pl and get:
import Data.List (groupBy)
import Control.Monad (ap)
import Control.Monad.Instances()
ranges = (((map.map) snd)
. groupBy (const fst))
.) =<< zip
. (True:)
. ((zipWith ((==) . succ)) `ap` tail)
, which, by my authoritative definition, is evil due to Mondad ((->) a). Twice, even. The data flow is meandering too much to lay it out in any sensible way. zipaptail is an Aztec god, and Aztec gods aren't to be messed with.
Another version in Erlang:
part(List) -> part(List,[]).
part([H1,H2|T],Acc) when H1 =:= H2 - 1 ->
part([H2|T],[H1|Acc]);
part([H1|T],Acc) ->
[lists:reverse([H1|Acc]) | part(T,[])];
part([],Acc) -> Acc.
k z = map (fst <$>) . groupBy (const snd) .
zip z . (False:) . (zipWith ((==) . succ) <*> tail) $ z
Try reusing standard functions.
import Data.List (groupBy)
rangeify :: (Num a) => [a] -> [[a]]
rangeify l = map (map fst) $ groupBy (const snd) $ zip l contigPoints
where contigPoints = False : zipWith (==) (map (+1) l) (drop 1 l)
Or, following (mixed) advice to use unfoldr, stop abusing groupBy, and be happy using partial functions when it doesn't matter:
import Control.Arrow ((***))
import Data.List (unfoldr)
spanContig :: (Num a) => [a] -> [[a]]
spanContig l =
map fst *** map fst $ span (\(a, b) -> a == b + 1) $ zip l (head l - 1 : l)
rangeify :: (Num a) => [a] -> [[a]]
rangeify = unfoldr $ \l -> if null l then Nothing else Just $ spanContig l
Erlang using foldr:
ranges(List) ->
lists:foldr(fun (X, [[Y | Ys], Acc]) when Y == X + 1 ->
[[X, Y | Ys], Acc];
(X, Acc) ->
[[X] | Acc]
end, [], List).
This is my v0.1 and I can probably make it better:
makeCont :: [Int] -> [[Int]]
makeCont [] = []
makeCont [a] = [[a]]
makeCont (a:b:xs) = if b - a == 1
then (a : head next) : tail next
else [a] : next
where
next :: [[Int]]
next = makeCont (b:xs)
And I will try and make it better. Edits coming I think.
As a comparison, here's an implementation in Erlang:
partition(L) -> [lists:reverse(T) || T <- lists:reverse(partition(L, {[], []}))].
partition([E|L], {R, [EL|_] = T}) when E == EL + 1 -> partition(L, {R, [E|T]});
partition([E|L], {R, []}) -> partition(L, {R, [E]});
partition([E|L], {R, T}) -> partition(L, {[T|R], [E]});
partition([], {R, []}) -> R;
partition([], {R, T}) -> [T|R].
The standard paramorphism recursion scheme isn't in Haskell's Data.List module, though I think it should be. Here's a solution using a paramorphism, because you are building a list-of-lists from a list, the cons-ing is a little tricksy:
contig :: (Eq a, Num a) => [a] -> [[a]]
contig = para phi [] where
phi x ((y:_),(a:acc)) | x + 1 == y = (x:a):acc
phi x (_, acc) = [x]:acc
Paramorphism is general recursion or a fold with lookahead:
para :: (a -> ([a], b) -> b) -> b -> [a] -> b
para phi b [] = b
para phi b (x:xs) = phi x (xs, para phi b xs)
It can be pretty clear and simple in the Erlang:
partition([]) -> [];
partition([A|T]) -> partition(T, [A]).
partition([A|T], [B|_]=R) when A =:= B+1 -> partition(T, [A|R]);
partition(L, P) -> [lists:reverse(P)|partition(L)].
Edit: Just for curiosity I have compared mine and Lukas's version and mine seems about 10% faster either in native either in bytecode version on testing set what I generated by lists:usort([random:uniform(1000000)||_<-lists:seq(1,1000000)]) on R14B01 64b version at mine notebook. (Testing set is 669462 long and has been partitioned to 232451 sublists.)
Edit2: Another test data lists:usort([random:uniform(1000000)||_<-lists:seq(1,10000000)]), length 999963 and 38 partitions makes bigger diference in native code. Mine version finish in less than half of time. Bytecode version is only about 20% faster.
Edit3: Some microoptimizations which provides additional performance but leads to more ugly and less maintainable code:
part4([]) -> [];
part4([A|T]) -> part4(T, A, []).
part4([A|T], B, R) when A =:= B+1 -> part4(T, A, [B|R]);
part4([A|T], B, []) -> [[B]|part4(T, A, [])];
part4([A|T], B, R) -> [lists:reverse(R, [B])|part4(T, A, [])];
part4([], B, R) -> [lists:reverse(R,[B])].
Here's an attempt from a haskell noob
ranges ls = let (a, r) = foldl (\(r, a#(h:t)) e -> if h + 1 == e then (r, e:a) else (a:r, [e])) ([], [head ls]) (tail ls)
in reverse . map reverse $ r : a

Resources