-- | 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

-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.

-- 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)

+ -- * List functions (for @[Bool]@)

+ , binaryToGray, grayToBinary

+ , bitsToBinary, binaryToBits

+ ( Bits, testBit, setBit, clearBit, bitSize

+ , shiftL, shiftR, complement, xor, (.&.), (.|.), isSigned)

+-- | Right shift without extension of the sign bit (reset it to zero).

+shiftR' :: (Bits a) => a -> Int -> a

+ | isSigned n && signum n == -1 =

+ let n' = clearBit (shiftR n 1) (bitSize n - 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' mask0 n (copyMSB n)

+ mask0 = let m = setBit 0 sz in (m, m)

+ copyMSB n = (setBit 0 sz) .&. n

+binary' (maskReady, maskLast) ngray nbin

+ | complement maskReady == 0 = nbin

+ nReady = maskReady .&. nbin

+ maskReady' = setBit (shiftR maskReady 1) sz

+ maskLast' = shiftR' maskLast 1

+ nNext = (shiftR' (maskLast .&. nReady) 1) `xor` (maskLast' .&. ngray)

+ 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 `~~xor~~` c : binaryToGray (c:bs)

+binaryToGray (b:c:bs) = b `boolXOR` c : binaryToGray (c:bs)

--- | Take~~s~~ a list of bits in Gray code and convert~~s~~ them to binary encoding

+-- | Take a list of bits in Gray code and convert them to binary encoding

-- (most significant bit last).

--- Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms,

--- Second ed. (2004), 5.4. Gray Codes.

grayToBinary :: [Bool] -> [Bool]

grayToBinary = foldr go []

- go c bs@(b:_) = b `~~xor~~` c : bs

+ go c bs@(b:_) = b `boolXOR` c : bs

-- | Convert a number to a list of bits in usual binary encoding (most

--- As 'bitSize', 'bitsToBinary' is undefined for ~~type~~s that do not

+-- As 'bitSize', 'bitsToBinary' is undefined for negative numbers that do not

-- have fixed bitsize, like 'Integer'.

bitsToBinary :: (Bits b) => b -> [Bool]

-- | Convert a list of bits in binary encoding to a number.

-binaryToBits :: (Bits ~~a~~) => [Bool] -> ~~a~~

+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 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