# hs-gray-code / Codec / Binary / Gray.hs

 ``` 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108``` ```-- | Gray code is a binary numeral system where two successive numbers -- differ in only one bit. -- -- Algorithm: -- Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms, -- Second ed. (2004), 5.4. Gray Codes. module Codec.Binary.Gray ( -- * Bitwise functions (for @Bits@ types) gray, binary -- * List functions (for @[Bool]@) , binaryToGray, grayToBinary , bitsToBinary, binaryToBits -- * Pretty printing , showBits, showBinary ) where import Data.Bits ( Bits, testBit, setBit, clearBit, bitSize , shiftL, shiftR, complement, xor, (.&.), (.|.), isSigned) import Debug.Trace -- | Right shift without extension of the sign bit (reset it to zero). shiftR' :: (Bits a) => a -> Int -> a shiftR' n 0 = n shiftR' n s | isSigned n && signum n == -1 = let n' = clearBit (shiftR n 1) (bitSize n - 1) in shiftR' n' (s-1) | otherwise = shiftR n s -- | Convert an integer number from binary to Gray code. -- -- As 'bitSize', 'gray' is undefined for negative numbers that do not -- have fixed bitsize, like 'Integer'. gray :: (Bits a) => a -> a gray n = n `xor` (shiftR' n 1) -- | Convert an integer number from Gray code to binary. -- -- As 'bitSize', 'binary' is undefined for types that do not -- have fixed bitsize, like 'Integer'. binary :: (Bits a) => a -> a binary 0 = 0 binary n = binary' mask0 n (copyMSB n) where sz = bitSize n - 1 mask0 = let m = setBit 0 sz in (m, m) copyMSB n = (setBit 0 sz) .&. n binary' (maskReady, maskLast) ngray nbin | complement maskReady == 0 = nbin | otherwise = let sz = bitSize ngray - 1 nReady = maskReady .&. nbin maskReady' = setBit (shiftR maskReady 1) sz maskLast' = shiftR' maskLast 1 nNext = (shiftR' (maskLast .&. nReady) 1) `xor` (maskLast' .&. ngray) in binary' (maskReady', maskLast') ngray (nReady .|. nNext) 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. binaryToGray :: [Bool] -> [Bool] binaryToGray (b:c:bs) = b `boolXOR` c : binaryToGray (c:bs) binaryToGray [b] = [b] binaryToGray [] = [] -- | Take a list of bits in Gray code and convert them to binary encoding -- (most significant bit last). grayToBinary :: [Bool] -> [Bool] grayToBinary = 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 last). -- -- As 'bitSize', 'bitsToBinary' is undefined for negative numbers 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 b) => [Bool] -> b 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 -- | Render a binary code as a string of @0@s and @1@s. -- For example, @(42:Int8)@ is formatted as @101010@. showBits :: (Bits a) => a -> String showBits = showBinary . bitsToBinary ```