Haskell BigInt addition

Question

I have a function add that adds two lists of integers:

add [1, 2] [4, 5, 8] == [4, 7, 0]
add [9, 8, 9] [1, 3] == [1, 0, 0, 2]

I know that Integer from Prelude is already arbitrary large, I'm reinventing the wheel for exercise.

Here's the code:

import Data.Int(Int8)

-- Adds two integer lists.
-- Examples:
-- add [1, 2] [4, 5, 8] == [4, 7, 0]
-- add [9, 8, 9] [1, 3] == [1, 0, 0, 2]
add :: [Int8] -> [Int8] -> [Int8]
add xs ys = toIntList $ foldr addCarry [] sumWithCarry
  where (paddedXs, paddedYs) = padToSameLength xs ys
        sumWithCarry = foldr getSumAndCarry [] $ zip paddedXs paddedYs
        -- Turn the list of sums with carry into a list of sums
        toIntList [] = []
        -- If the first pair has a carry of one, add that to the list.
        -- This ensures that the resulting list can grow one digit
        toIntList xs@((_,carry):_) | carry >0  = carry : map fst xs
                                   | otherwise = map fst xs

-- Pads two lists of ints to the same length
-- by prepending zeros to the shorter one
padToSameLength xs ys =
  if lenDiff < 0
  then (padWithLeadingZeros xs (lenDiff * (-1)), ys)
  else (xs, padWithLeadingZeros ys lenDiff)
  where lenDiff = length xs - length ys
        padWithLeadingZeros list nr = take nr (repeat 0) ++ list

-- Given two same-sized list of ints, returns them
-- zipped as pairs of their sum and carry.
-- Example: getSumAndCarry [1, 2] [4, 8] == [(5, 0), (0, 1)]
getSumAndCarry :: (Int8, Int8) -> [(Int8, Int8)] -> [(Int8, Int8)]
getSumAndCarry (x, y) pairs = sumWithCarry x y : pairs
  where sumWithCarry x y | x + y >= 10 = ((x + y) - 10, 1)
                         | otherwise   = (x + y, 0)

-- Once we have added two lists like [7, 9, 8] and [2, 1, 4] to a list
-- of sums and carries, [(9, 0), (0, 1), (2, 1)],
-- we want to add the carry: [(9, 1), (1, 0), (2, 0)]
addCarry :: (Int8, Int8) -> [(Int8, Int8)] -> [(Int8, Int8)]
-- The rightmost pair. We don't do much since only the pair's left
-- neighbor will use its carry
addCarry pair [] = [pair]
addCarry (sum, carry) pairs@((_, prevCarry):_) =
  sumWithCarry sum carry prevCarry : pairs
  where sumWithCarry sum carry prevCarry | sum + carry + prevCarry >= 10 = ((sum + carry + prevCarry) - 10, 1)
                                         | otherwise = (sum + carry + prevCarry, 0)

It seems to work correctly but I'd really like to improve the code:

• Generally, make it shorter wherever possible
• Specifically, combine the functions getSumAndCarry and addCarry if possible since both traverse the list, and I'd prefer add to be O(n).

Thanks a lot for your feedback!

---

For anyone interested, here's a version incorporating Zeta's feedback. It's tested with QuickCheck and does not suffer from the carry bug of the original code.

Answer 1

Your code contains at least one bug, therefore this review is a little bit shorter than usual since you need to fix that bug either way.

So let's instead have a look at testing and how you can find bugs like this.

Testing

I'll start with testing since the presented code contains bugs. That's due to the carry logic. It works for your small examples, but QuickCheck can come up with several examples that won't work.

First, we need some additional functions:

import Data.List (foldl')
import Test.QuickCheck

type Digit = Int8

fromDigits :: [Digit] -> Integer
fromDigits = foldl' (\a x -> a * 10 + x) 0 . map fromIntegral

toDigits :: Integral n => n -> [Digit]
toDigits n | n < 0 = []
toDigits 0 = [0]
toDigits n = reverse . map fromIntegral . go $ n
  where
    go 0 = []
    go n = let (q,r) = n `quotRem` 10 in r : go q

We should test that fromDigits and toDigits work correctly:

prop_digitIdentity1 (NonNegative x) = fromDigits (toDigits x) === x

prop_digitIdentity2 =
    forAll validDigits $ \x ->
      toDigits (fromDigits x) === x
  where
    validDigits = fixEmpty . dropWhile (== 0) <$> listOf (choose (0,9))
    fixEmpty [] = [1]
    fixEmpty xs = xs

QuickCheck tells us that our properties hold:

*Main> quickCheck prop_digitIdentity1
+++ OK, passed 100 tests.
*Main> quickCheck prop_digitIdentity2
+++ OK, passed 100 tests.

Now it's time to write a test for add:

prop_add (NonNegative x) (NonNegative y) =
    toDigit x `add` toDigit y === toDigit (x + y)

If we run this now we get a counter example:

*Main> quickCheck prop_add
*** Failed! Falsifiable (after 63 tests and 5 shrinks):     
NonNegative {getNonNegative = 50}
NonNegative {getNonNegative = 50}
[1,0] /= [1,0,0]

So add doesn't work for [5,0] [5,0]. Essentially, it doesn't work whenever the carry needs to propagate. I didn't look into this in detail, though.

Further remarks

padToSameLength should get a type signature. Also, take n (repeat x) is replicate n x.

We can make padToSameLength a little bit easier to read if we add additional whitespace:

padToSameLength :: Num a => [a] -> [a] -> ([a],[a])
padToSameLength xs ys =
  if lenDiff < 0
      then (padWithLeadingZeros xs (lenDiff * (-1)), ys)
      else (xs, padWithLeadingZeros ys lenDiff)
  where 
      lenDiff = length xs - length ys
      padWithLeadingZeros list nr = take nr (repeat 0) ++ list

Or we could remove the if completely, since replicate with non-positive arguments yields an empty list:

padToSameLength :: Num a => [a] -> [a] -> ([a],[a])
padToSameLength xs ys = (pad diff xs, pad (-diff) ys)
  where
    diff = length ys - length xs
    pad n ps = replicate n 0 ++ ps

Use map g instead of foldr f [] where applicable

If you have a function f value list = g value : list, then foldr f [] list is the same as map g list. This certainly holds for an empty list:

foldr f [] []     = map g [] = []

So let's say it holds that foldr f [] xs == map g xs, we have to check that foldr f [] (x:xs) == map g (x:xs) for all x:

foldr f [] (x:xs) = x `f` foldr f [] xs
                  = g x : foldr f [] xs -- induction
                  = g x : map g xs
                  = map g (x:xs)

Therefore, we can simplify getSumWithCarry:

add :: [Int8] -> [Int8] -> [Int8]
add xs ys = toIntList $ foldr addCarry [] sumWithCarry
  where (paddedXs, paddedYs) = padToSameLength xs ys
        sumWithCarry = map getSumWithCarry $ zip paddedXs paddedYs

        -- Turn the list of sums with carry into a list of sums
        toIntList [] = []
        -- If the first pair has a carry of one, add that to the list.
        -- This ensures that the resulting list can grow one digit
        toIntList xs@((_,carry):_) | carry >0  = carry : map fst xs
                                   | otherwise = map fst xs

        -- Combines two digits to their sum and their carry
        getSumWithCarry (x,y) | x + y >= 10 = ((x + y) - 10, 1)
                              | otherwise   = (x + y, 0)

Use zipWith f xs instead of map (uncurry f) . zip xs

However, map f $ zip xs ys is the same as zipWith (curry f) xs ys, so let's further simplify add:

add :: [Int8] -> [Int8] -> [Int8]
add xs ys = toIntList $ foldr addCarry [] sumWithCarry
  where (paddedXs, paddedYs) = padToSameLength xs ys
        sumWithCarry = zipWith getSumWithCarry paddedXs paddedYs

        toIntList [] = []
        toIntList xs@((_,carry):_) | carry >0  = carry : map fst xs
                                   | otherwise = map fst xs

        getSumWithCarry x y | x + y >= 10 = ((x + y) - 10, 1)
                            | otherwise   = (x + y, 0)

We cannot get rid of foldr addCarry, since addCarry v l isn't g v : l for any suitable l.

Use a simpler algorithm (first)

Usually, with addition, we want to start with the least significant digit. This is a lot easier if we reverse the digits first:

addBase :: Integral n => n -> [n] -> [n] -> [n]
addBase base as bs =
    cleanup $ mapAccumL go $ zipWithPad 0 (+) (reverse as) (reverse bs)
  where
    go carry sum = (carry + sum) `quotRem` base
    cleanup      = -- exercise, but very similar to addCarry

zipWithPad :: a -> (a -> a -> a) -> [a] -> [a]
zipWithPad a f xs ys = -- left as exercise