CODEWITHSUNDEEP
listhaskellrecursionbinary
David
David

Reputation: 457

Adding two binary numbers stored as lists of 0s and 1s in Haskell, without using reverse

I am trying to solve this simple problem in an elegant and expressive way. Usually, I would start from the end of both lists, add the corresponding elements and store a carry to compute the next digits. However, I am struggling to solve this with recursion and without using the reverse function.

This is my first attempt:

binarySum :: [Int] -> [Int] -> [Int]
binarySum ls ls'
  = let (res, c) = binarySum' ls ls' in c : res
  where
binarySum' [x] [y]
  = let (s, c) = add x y in ([s], c)
binarySum' (x : xs) (y : ys)
  = (s : res, c')
  where
    (res, c) = binarySum' xs ys
    (s, c')  = add' x y c

(where the add and add' functions perform the needed operations)

The resulting list appears to be correct, but in reverse order. I don't know how to proceed since I chose to build the result in the pair that is returned along with the carry in the auxiliary function (normally I would do something like s : binarySum'...).

Also I feel like the code is too cluttered and not as elegant as it should be.

Any help is greatly appreciated!

Upvotes: 0

Views: 1931

Answers (2)

Tarek Soliman
Tarek Soliman

Reputation: 71

Four years too late. I don't care though:

(+++) :: [Int] -> [Int] -> [Int]
(+++) n1 n2 = f2 $ foldr f1 ([],0) (copulate n1 n2)
  where
    -- immitates `zip`
    -- but it will make sure that both lists are of same length.
    -- if they are not of the same length, then the shorter list
    -- will be adjusted accordingly.
    copulate :: [Int] -> [Int] -> [(Int,Int)]
    copulate n1 n2
      | length n1 == length n2 = zip n1 n2
      | otherwise = 
          let diff = abs (length n1 - length n2)
          in if length n1 > length n2
               then zip n1 (replicate diff 0 ++ n2)
             else zip (replicate diff 0 ++ n1) n2
    
    f1 :: (Int,Int) -> ([Int],Int) -> ([Int],Int)    
    f1 (x,y) (res,z)
      | any (`notElem` [0,1])[x,y] = error "can only process binary bits"
      | otherwise = 
          let (l,rest) = f3 x y z
          in (l : res,rest)  

    --adding the rest if exists any
    f2 :: ([Int],Int) -> [Int]
    f2 (list,0) = list
    f2 (list,1) = [1] ++ list
    
    --doing the addition and calculating the rest
    f3 :: Int -> Int -> Int -> (Int,Int)
    f3 x y z = ((x+y+z) `mod` 2,if x+y+z>=2 then 1 else 0)

foldr is great to traverse from the right side without reversing. Besides, the whole list is being processed, and the function is strict in strict in f1 which makes foldr perfect for this operation.

Look at the accumulator of foldr. It's in the beginning a tuple: ([],0).

  • The first element in the tuple will store the result.
  • The second element in the tuple will store the "state" of the adding each bits. This "state" will influence the pair of following tuples in case its value is 1.

now you can test it: [1,0,1] +++ [1,0,0] will give 1001 And thanks for the infix operator, you'll be able to chain more addition if you want to, like: [1,0,1] +++ [1,0,0] +++ [1,0,0,0,0,0,0]

Even though the answer looks lengthy, it was so easy to rationalize and to write, which makes it not lengthy in logic, and I find this solution easier than recursion.

Upvotes: 0

Alec
Alec

Reputation: 32309

You are almost there (at least your explanation seems to indicate so - your code relies on an add function you haven't included). The trick is indeed to keep the carry as a separate number in a tuple in an auxiliary function (which I've named binarySum'). The invariant you are working with is then that the list returned has the same length as the larger of the two lists provided (and is the first digits of their sum) - a carry, if there is any, is held separately. 

binarySum :: [Int] -> [Int] -> [Int]
binarySum xs ys
  | length xs < length ys = binarySum (replicate (length ys - length xs) 0 ++ xs) ys
  | length xs > length ys = binarySum xs (replicate (length xs - length ys) 0 ++ ys)
  | otherwise = case binarySum' xs ys of
                    (0, zs) -> zs
                    (1, zs) -> 1:zs
  where
    binarySum' :: [Int] -> [Int] -> (Int, [Int])
    binarySum' [] ys = (0, ys)
    binarySum' xs [] = (0, xs)
    binarySum' (x:xs) (y:ys) = let (c, zs) = binarySum' xs ys
                                   (c', z) = (x + y + c) `divMod` 2
                               in (c', z:zs)

Upvotes: 2

Related Questions