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