How to break out from a fold function in haskell when the accumulator met a certain condition?

Question

I'm calculating the sum of a list after applying someFunction to every element of it like so:

sum (map someFunction myList)

someFunction is very resource heavy so to optimise it I want to stop calculating the sum if it goes above a certain threshold.

It seems like I need to use fold but I don't know how to break out if it if the accumulator reaches the threshold. My guess is to somehow compose fold and takeWhile but I'm not exactly sure how.

Answer 1

Another technique is to use a foldM with Either to capture the early termination effect. Left signals early termination.

import Control.Monad(foldM)

sumSome :: (Num n,Ord n) => n -> [n] -> Either n n
sumSome thresh = foldM f 0
  where
    f a n 
      | a >= thresh = Left a
      | otherwise   = Right (a+n)

To ignore the exit status, just compose with either id id.

sumSome' :: (Num n,Ord n) => n -> [n] -> n
sumSome' n = either id id . sumSome n

Answer 2

One of the options would be using scanl function, which returns a list of intermediate calculations of foldl.

Thus, scanl1 (+) (map someFunction myList) will return the intermediate sums of your calculations. And since Haskell is a lazy language it won't calculate all the values of myList until you need it. For example:

take 5 $ scanl1 (+) (map someFunction myList)

will calculate someFunction 5 times and return the list of these 5 results.

After that you can use either takeWhile or dropWhile and stop the calculation, when a certain condition is True. For example:

head $ dropWhile (< 1000) $ scanl1 (+) [1..1000000000]

will stop the calculation, when sum of the numbers reaches 1000 and returns 1035.

Answer 3

Use a bounded addition operator instead of (+) with foldl.

foldl (\b a -> b + if b > someThreshold then 0 else a) 0 (map someFunction myList)

Because Haskell is non-strict, only calls to someFunction that are necessary to evaluate the if-then-else are themselves evaluated. fold still traverses the entire list.

> foldl (\b a -> b + if b > 10 then 0 else a) 0 (map (trace "foo") [1..20])
foo
foo
foo
foo
foo
15

sum [1..5] > 10, and you can see that trace "foo" only executes 5 times, not 20.

Instead of foldl, though, you should use the strict version foldl' from Data.Foldable.

Answer 4

This will do what you ask about without building the intermediate list as scanl' would (and scanl would even cause a thunks build-up on top of that):

foldl'Breaking break reduced reducer acc list = 
    foldr cons (\acc -> acc) list acc 
          where 
          cons x r acc | break acc x = reduced acc x 
                       | otherwise   = r $! reducer acc x

cf. related wiki page.

Answer 5

You could try making your own sum function, maybe call it boundedSum that takes

1. an Integer upper bound

2. an [Integer] to sum over

3. a "sum up until this point" value to be compared with the upper bound

and returns the sum of the list.

    boundedSum :: Integer -> [Integer] -> Integer -> Integer
    boundedSum upperBound (x : xs) prevSum =
        let currentSum = prevSum + x
            in
        if   currentSum > upperBound
        then upperBound
        else boundedSum upperBound xs currentSum
    boundedSum upperBound [] prevSum =
        prevSum

I think this way you won't "eat up" more of the list if the sum up until the current element exceeds upperBound.

EDIT: The answers to this question suggest better techniques than mine and the question itself looks rather similar to yours.

Answer 6

This is a possible solution:

last . takeWhile (<=100) . scanl (+) 0 . map (^2) $ [1..]

Dissected:

• take your starting list ([1..] in the example)
• map your expensive function ((^2))
• compute partial sums scanl (+) 0
• stop after the partial sums become too large (keep those (<=100))
• take the last one

If performance matters, also try scanl', which might improve it.

Answer 7

Something like this using until :: (a -> Bool) -> (a -> a) -> a -> a from the Prelude

sumUntil :: Real a => a -> [a] -> a
sumUntil threshold u = result

    where

    (_, result) = until stopCondition next (u, 0)

    next :: Real a => ([a], a) -> ([a], a)
    next ((x:xs), y) = (xs, x + y)

    stopCondition :: Real a => ([a], a) -> Bool
    stopCondition (ls, x) = null ls || x > threshold

Then apply

sumUntil 10 (map someFunction myList)

Answer 8

This post is already a bit older but I'd like to mention a way to generalize the nice code of @trevor-cook above to break fold with the additional possibility to return not only a default value or the accumulator but also the index and element of the list where the breaking condition was satisfied:

import Control.Monad (foldM)

breakFold step initialValue list exitCondition exitFunction = 
  either id (exitFunction (length  list) (last list)) 
      (foldM f initialValue (zip [0..] list))
    where f acc (index,x)
            | exitCondition index x acc 
                        = Left (exitFunction index x acc)
            | otherwise = Right (step index x acc)

It also only requires to import foldM. Examples for the usage are:

mysum thresh list = breakFold (\i x acc -> x + acc) 0 list 
                         (\i x acc -> x + acc > thresh) 
                         (\i x acc -> acc)
myprod thresh list = breakFold (\i x acc -> x * acc) 1 list 
                          (\i x acc -> acc == thresh) 
                          (\i x acc -> (i,x,acc))

returning

*myFile> mysum 42 [1,1..]
42
*myFile> myprod 0 ([1..5]++[0,0..])
(6,0,0)
*myFile> myprod 0 (map (\n->1/n) [1..])
(178,5.58659217877095e-3,0.0)

In this way, one can use the index and the last evaluated list value as input for further functions.

Answer 9

Despite the age of this post, I'll add a possible solution. I like continuations because I find them very useful in terms of flow control.

breakableFoldl
  :: (b -> a -> (b -> r) -> (b -> r) -> r)
  -> b
  -> [a]
  -> (b -> r)
  -> r
breakableFoldl f b (x : xs) = \ exit ->
    f b x exit $ \ acc ->
        breakableFoldl f acc xs exit
breakableFoldl _ b _ = ($ b)

breakableFoldr
  :: (a -> b -> (b -> r) -> (b -> r) -> r)
  -> b
  -> [a]
  -> (b -> r)
  -> r
breakableFoldr f b l = \ exit ->
  fix (\ fold acc xs next ->
    case xs of
      x : xs' -> fold acc xs' (\ acc' -> f x acc' exit next)
      _ -> next acc) b l exit

exampleL = breakableFoldl (\ acc x exit next ->
    ( if acc > 15
      then exit
      else next . (x +)
    ) acc
  ) 0 [1..9] print

exampleR = breakableFoldr (\ x acc exit next ->
    ( if acc > 15
      then exit
      else next . (x +)
    ) acc
  ) 0 [1..9] print