Search code examples
functionhaskellrecursionfunctional-programming

How can I write a haskell function that applies a function on a list until one of its parameters turns 0?


I have to write the following haskell function:

It receives an Integer (let's call it h) and a list of Integers as parameters. It should iterate through the list, and increment the value of each element that is divisible by 2. Whenever it does this, it decrements the value of h by 1. It should repeat this process until h is 0. If it reaches the end of the list and the value of h is not zero, it should start the whole process all over again, until it does become 0. It should also work on infinite lists. In the following test case: inc_until 4 [1,2,3,4,5] it should return [1,4,3,6,5]

I'm not allowed to use anything besides guards, pattern matching, and helper functions I have written myself.

inc_until :: Integer -> [Integer] -> [Integer]
inc_until _ [] = []
inc_until h (x:xs)
 | x `mod` 2 == 0 = (x+1) : inc_until (h-1) xs
 | otherwise = inc_until h xs

This only iterates through the list once, so it stops even when the value of h is not zero.


Solution

  • Analysis We have three scenarios to cope with:

    • The list is infinite -- we assume has infinitely many evens, though not necessarily equally spaced: then we can only increment the first h of them (by +1 each), and return the tail untouched/not incremented. So decrementing the h as we go avoids running down the list for ever.
    • The list is finite, but has at least h many evens; treat this same as the first case: increment the first h evens, return the tail untouched/not incremented.
    • The list is finite, and has strictly fewer than h evens: now it needs "distribute the value of h evenly", see below ...

    Deviant scenarios [added in later edit]

    • The list is infinite but contains no evens, or fewer than h many evens. This condition is not detectable in finite time/space, so the code here will run for ever/until resources are exhausted.
    • The list is finite but contains no evens. The code here will return the list unchanged. Arguably this should be an error condition.

    First pass

    • Count the number of evens; also decrement h for each one;
    • Stop and return the count if either h declines to zero; or end of list.

    Second pass (This is the messy part.)

    • Iterate over the original list, incrementing the evens by a rounded-up increment, and decrementing both h by that increment, and the count by -1;
    • At each even, divide the h by the count and round up to give the increment for this element;
    • (the evens in the beginning of the list are to be incremented by this rounded-up amount, until we've got only enough of h left over to increment the rest by a rounded-down value)
    • when the decrementing h falls to be exactly divisible by the decrementing count, then increment the remaining evens by that exact quotient (which'll be 1 less than the rounded-up at the beginning).

    examples

    • inc_until 5 [1,2,3,4,5] (count 2 evens) ==> [1,5,3,6,5]

    • take 17 $ inc_until 5 [1,2 ..] ==> [1,3,3,5,5,7,7,9,9,11,11,12,13,14,15,16,17]

      • (infinite input ==> infinite output, truncated for display)
    module Inc_until  where
    
        inc_until :: Int -> [Int] -> [Int]
        inc_until    h      xss    = go h xss 0
          where
            go :: Int -> [Int] -> Int -> [Int]
            go    0      _xss     c    = go2 h xss c      -- exhausted h  
            go    _h     []       c    = go2 h xss c      -- end of list,
                                                          -- didn't exhaust h
            go    h      (x:xs)   c    | even x    = go (h - 1) xs (c + 1)
                                       | otherwise = go  h      xs  c
            
            go2 :: Int -> [Int] -> Int -> [Int]
            go2    0      xss      _    = xss        -- exhausted h
            go2    h      []       _    = []         -- shouldn't get here
            go2    h      xss      0    = xss        -- shouldn't get here either
            go2    h     (x:xs)    c    | even x    = let q = floor (fromIntegral h / fromIntegral c + 0.5) 
                                                      in  (x + q) : go2 (h - q) xs (c - 1)
                                        | otherwise =      x      : go2  h      xs  c
            
    

    Notes

    • For the first two scenarios, it would be fine to follow Daniel's approach of accumulating the incremented front of the list in reverse order; and return that if h got exhausted;

      • but since we have go2 anyway, the rounded quotient for (say) 3 / 3 comes out right as 1, we can avoid creating the temp list.
    • IMO the code is cleaner if pass 1 merely accum's the count of evens. [YMMV]

    • To get the count of evens, we can't merely filter/fold over the list: it might be infinite/there might be more than h many evens.

    • In testing, I found the round function was occasionally giving out-by-1 errors; hence the ugly business with floor. Of course it's arbitrary whether you round up at the beginning vs. round down at the beginning until you've enough remainder to round up the trailing elements.

    Afterthoughts

    Heh heh even this short exercise shows how code changes as you explore what's left unsaid in the spec/typically bump into deviant/unanticipated scenarios -- and the code builds up a 'legacy' of sub-optimal (but not sufficiently bad to fix) cruft. Examples:

    • I was at first worried about the messiness of rounding up the quotient at the start of "distribute the value of h evenly"; then rounding down later.
    • But the floor ( ... / ... + 0.5) expression does the appropriate rounding automatically.
    • I at first coded go using the prefix accumulator per Daniel's answer -- so the go 0 ... equation (h exhausted) would return immediately; and accumulating the count in parallel -- which is why go has an over-complex accumulating logic.
    • I then realised if count reaches same as h the quotient and rounding logic would work just as well for say 3 / 3, so also called go2 and stripped out the accumulating prefix logic.
    • But that results in go merely counting the number of evens (or h, whichever is the smaller) -- in which case carrying the count down the recursive descent is over-complex. Instead it could be:
        inc_until    h      xss    = go2 h xss (count_evens h xss) 
          where
            count_evens :: Int -> [Int] -> Int
            count_evens    0      _xss   = 0
            count_evens    _h     []     = 0
            count_evens    h      (x:xs) | even x    = 1 + count_evens (h - 1) xs
                                         | otherwise =     count_evens  h      xs
    
          -- go2 as above
    
    • BTW I'm not criticising Daniel's solution: it's perfectly workable for the problem as originally stated. The "distribute the value of h evenly" requirement didn't appear until after Daniel posted that solution, and still it's only in a comment. Something like that wholly upending the 'spec' should be in the main question.