Gray.hs

-- | Gray code is a binary numeral system where two successive numbers
-- differ in only one bit.
module Codec.Binary.Gray
    (
      -- * List functions (for @[Bool]@)
      binaryToGray, grayToBinary
    , bitsToBinary, binaryToBits
    , showBinary
    ) where

import Data.Bits (Bits, testBit, shiftR, bitSize)
    
xor :: Bool -> Bool -> Bool
xor p q = (p && not q) || (not p && q)

-- | Takes a list of bits (most significant last) in binary encoding
-- and converts them to Gray code.
--
-- Algorithm:
--   Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms,
--   Second ed. (2004),  5.4. Gray Codes.
binaryToGray :: [Bool] -> [Bool]
binaryToGray (b:c:bs) = b `xor` c : binaryToGray (c:bs)
binaryToGray [b] = [b]
binaryToGray [] = []

-- | Takes a list of bits in Gray code and converts them to binary encoding
-- (most significant bit last).
--
-- Algorithm:
--   Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms,
--   Second ed. (2004),  5.4. Gray Codes.
grayToBinary :: [Bool] -> [Bool]
grayToBinary = foldr go []
  where go c [] = [c]
        go c bs@(b:_) = b `xor` c : bs

-- | Convert a number to a list of bits in usual binary encoding (most
-- significant last).
-- 
-- As 'bitSize', 'bitsToBinary' is undefined for types that do not
-- have fixed bitsize, like 'Integer'.
bitsToBinary :: (Bits b) => b -> [Bool]
bitsToBinary 0 = []
bitsToBinary i
    | signum i == (-1) =
        let b = map not . bitsToBinary $ negate i - 1
        in  b ++ (take (bitSize i - length b) $ repeat True) -- pad major bits
    | otherwise        =
        let rest = bitsToBinary $ shiftR i 1  -- works only for positive i
        in  (testBit i 0 : rest)

-- | Convert a list of bits in binary encoding to a number.
binaryToBits :: (Bits a) => [Bool] -> a
binaryToBits = sum . map fst . filter snd . zip (map (2^) [0..])

-- | Render a list of bits as a 0-1 string.
showBinary :: [Bool] -> String
showBinary [] = "0"
showBinary bs = map (\b -> if b then '1' else '0') . reverse $ bs