Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Deciphering addC Code and carry

Tags:

haskell

Okay, so I have this code in Haskell:

data Bigit = O | I deriving (Show,Eq)

add x y = reverse $ addC O (reverse x) (reverse y)

addC O [] [] = []
addC I [] [] = [I]
addC carry [] r = addC carry [O] r
addC carry l [] = addC carry l [O]
addC carry (left:leftOver) (right:rightOver) = sumBigit :(addC newCarry leftOver    
                                                                             rightOver)
where
    (sumBigit,newCarry)
        = case (left,right,left) of
            (O,O,O) -> (O,O)
            (O,I,O) -> (I,O)
            (I,O,O) -> (I,O)
            (I,I,O) -> (O,I)
            (O,O,I) -> (I,O)
            (O,I,I) -> (O,I)
            (I,O,I) -> (O,I)
            (I,I,I) -> (I,I)

and I need to figure out what it means. So far, I understand that it's using bigits and lists of bigits as the type, and that a bigit is either I (representing a 1) and O (representing a 0).

I figured out that type signatures for add and addC:

add :: [Bigit] -> [Bigit] -> [Bigit]
addC :: Bigit -> [Bigit] -> [Bigit] -> [Bigit]

To help me understand, I've been loaded the code into GHCI and I've been playing around with it. For example, I know that if I tell it:

add [I,O] [I,O]

it gives me [I,I,O], because it follows:

reverse (addC O (reverse x) (reverse y))
reverse (addC O [O,I] [O,I])

But from here, I am confused on how to go about figuring out the addC part. I have the right arguments: a Bigit, and two lists of Bigits. However, I don't understand what pattern to match this to. I am quite confused about what the "carry" means. Can anyone try and help, please?

like image 768
user1056769 Avatar asked Nov 20 '11 20:11

user1056769


1 Answers

As has been explained in comments, the addC function operates on reversed binary code (with bits named Bigits for no real reason), and has a bug where carry needs to be included in the case pattern. The many variants of addC are to cover all possible combinations of input, particularly in the recursive call:

addC O [] [] = []

This is the case where we've run out of digits, and the carry input is zero. That means we don't need to add another digit and can return an empty list.

addC I [] [] = [I]

Here we have a carry left over when we run out of input terms, so we extend the result with a single digit. Once both lists are exhausted, either of these cases will match, and terminate the recursive evaluation since they do not call addC again.

addC carry [] r = addC carry [O] r

This is used to widen the left term since the right term is not exhausted (if it were, the earlier patterns would have matched it).

addC carry l [] = addC carry l [O]

Similarly, to widen the right term when the left term is not exhausted.

With all of these patterns, it is guaranteed that there are equal length lists for the main addC definition to work on, as well as that carries do not get lost in a length overflow. It could have been written differently, such that we just copied the left over portion of either term once carry is O and the other term is [], but the patterns are exhaustive and terminating, which is what matters most. A side note is that [] is a valid zero value as far as this adder is concerned.

addC carry (left:leftOver) (right:rightOver) = 
     sumBigit :(addC newCarry leftOver rightOver)
     where (sumBigit,newCarry) = ....

This is the meat of the function. It extracts one Bigit from each term, left and right, and uses a truth table to calculate a two bit sum from these and the carry bit (well, it would, if it were not buggy). The result holds the least significant bit of that sum, and then the recursive sum for the rest of both terms with the new carry value.

I took the liberty, as an exercise, to write the same concept using foldr. The result was not very pretty, but does avoid the reversal steps; lining up different length lists instead requires a separate extension step which I did by measuring the length of the lists.

extMatch :: a -> b -> [a] -> [b] -> [(a,b)]
extMatch a0 b0 a b = zip (ext a0 (lb-la) a) (ext b0 (la-lb) b)
  where ext x0 l x | l>0 = concat [replicate l x0, x]
                   | l<=0 = x
        la = length a
        lb = length b

add2 :: [Bigit] -> [Bigit] -> [Bigit]
add2 x y = extsum $ foldr addC2 (O, []) (extMatch O O x y)
  where extsum (O,sum) = sum
        extsum (I,sum) = I:sum

addC2 :: (Bigit, Bigit) -> (Bigit, [Bigit]) -> (Bigit, [Bigit])
addC2 (O, O) (O, sumbits) = (O, O:sumbits)
addC2 (O, O) (I, sumbits) = (O, I:sumbits)
addC2 (O, I) (O, sumbits) = (O, I:sumbits)
addC2 (O, I) (I, sumbits) = (I, O:sumbits)
addC2 (I, O) (O, sumbits) = (O, I:sumbits)
addC2 (I, O) (I, sumbits) = (I, O:sumbits)
addC2 (I, I) (O, sumbits) = (I, O:sumbits)
addC2 (I, I) (I, sumbits) = (I, I:sumbits)
like image 90
Yann Vernier Avatar answered Oct 22 '22 20:10

Yann Vernier