
On Thu, Mar 16, 2023 at 06:33:27PM -0700, Todd Wilson wrote:
Here's a basic exercise in list processing: define a function
runs :: Ord a => [a] -> [[a]]
that breaks up its input list into a list of increasing "runs"; e.g.,
runs [3,4,5,6,2,3,4,1,2,1] ---> [[3,4,5,6],[2,3,4],[1,2],[1]]
A natural solution is the following:
runs [] = [] runs (x:xs) = let (ys, zs) = run x xs in (x:ys) : runs zs where run x [] = ([], []) run x (y:ys) = if x <= y then let (us, vs) = run y ys in (y:us, vs) else ([], y:ys)
My question: can we do better than this? It seems that this solution is constantly building and breaking apart pairs. (Or is it, when optimized?)
The key feature of this solution is that it is lazy in the tail of the list of runs. For example, the below completes quickly despite ostensibly working with an infinite list of runs. It is able to "emit" the first run as soon as a successort is smaller than its predecessor. {-# LANGUAGE ScopedTypeVariables #-} module Main (main) where runs :: forall a. Ord a => [a] -> [[a]] runs [] = [] runs (x:xs) = let (ys, zs) = run x xs in (x:ys) : runs zs where run :: a -> [a] -> ([a], [a]) run x [] = ([], []) run x l@(y:ys) = if x <= y then let (us, vs) = run y ys in (y:us, vs) else ([], l) main :: IO () main = print $ sum $ map sum $ take 100 $ runs $ concat $ map (\i -> [0..i]) [0..] It is also able to generate the leading elements of an infinite first run: main :: IO () main = print $ sum $ take 100 $ head $ runs $ [0..] Any constant factors are less important. -- Viktor.