# hs-gray-code / Codec / Binary / Gray / Bits.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``` ```-- | Gray code is a binary numeral system where two successive numbers -- differ in only one bit. -- -- This module provides an interface to encode/decode @'Bits'@ types. -- -- Algorithm: -- Haupt, R.L. and Haupt, S.E., Practical Genetic Algorithms, -- Second ed. (2004), 5.4. Gray Codes. module Codec.Binary.Gray.Bits ( gray , binary , showBits ) where import Data.Bits ( Bits, testBit, setBit, clearBit, bitSize , shiftL, shiftR, complement, xor, (.&.), (.|.), isSigned) import qualified Codec.Binary.Gray.List as L -- | Right shift without extension of the sign bit (reset it to zero). shiftR' :: (Bits a, Num 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. -- -- 'gray' is undefined for negative numbers of types that do not have -- fixed bitsize, e.g. for negative 'Integer's. gray :: (Bits a, Num a) => a -> a gray n = n `xor` (shiftR' n 1) -- | Convert an integer number from Gray code to binary. -- -- 'binary' is undefined for types that do not have fixed bitsize, -- e.g. for 'Integer'. binary :: (Bits a, Num 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) -- | Render binary code as a string of @0@s and @1@s. -- For example, @(42::Int8)@ is formatted as @101010@. showBits :: (Bits a, Num a) => a -> String showBits = L.showBits . L.toList ```