-- | Gray code is a binary numeral system where two successive numbers -- differ in only one bit. -- -- This module provides an interface to encode/decode numbers -- represented as lists of @Bool@. -- -- Algorithm: -- Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms, -- Second ed. (2004), 5.4. Gray Codes. module Codec.Binary.Gray.List ( gray, binary , toList, toList', fromList , showBits ) where import Data.Bits (Bits, testBit, bitSize, shiftR, isSigned) boolXOR :: Bool -> Bool -> Bool boolXOR p q = (p && not q) || (not p && q) -- | Take a list of bits (most significant last) in binary encoding -- and convert them to Gray code. gray :: [Bool] -> [Bool] gray (b:c:bs) = b `boolXOR` c : gray (c:bs) gray [b] = [b] gray [] = [] -- | Take a list of bits in Gray code and convert them to binary encoding -- (most significant bit last). binary :: [Bool] -> [Bool] binary = foldr go [] where go c [] = [c] go c bs@(b:_) = b `boolXOR` c : bs -- | Convert a number to a list of bits in usual binary encoding (most -- significant bit last). Truncates unset major bits. -- -- This function is undefined for negative numbers of types that do not -- have fixed bitsize, like 'Integer'. toList :: (Bits b, Num b) => b -> [Bool] toList 0 = [] toList i | isSigned i && signum i == (-1) = let b = map not . toList $ negate i - 1 in b ++ (take (bitSize i - length b) $ repeat True) -- pad major bits | otherwise = let rest = toList $ shiftR i 1 -- works only for positive i in (testBit i 0 : rest) -- | Convert a number to a list of bits in usual binary encoding (most -- significant bit last). -- -- Like 'toList', but returns all unset major bits too. So the length -- of the output is always the same length as @bitSize i@. toList' :: (Bits b, Num b) => b -> [Bool] toList' i = map (testBit i) [0..bitSize i - 1] -- | Convert a list of bits in binary encoding to a number. fromList :: (Bits b, Num b) => [Bool] -> b fromList = sum . map fst . filter snd . zip (map (2^) [0..]) -- | Render a list of bits as a string of @0@s and @1@s. showBits :: [Bool] -> String showBits [] = "0" showBits bs = map (\b -> if b then '1' else '0') . reverse $ bs