gray-code 0.1 → 0.2

raw patch · 5 files changed

+203/−89 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Codec/Binary/Gray.hs +2/−58
• Codec/Binary/Gray/Bits.hs +65/−0
• Codec/Binary/Gray/List.hs +57/−0
• Codec/Binary/Gray_props.hs +70/−28
• gray-code.cabal +9/−3

@@ -1,60 +1,4 @@--- | 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..])+    ( module Codec.Binary.Gray.Bits ) where --- | 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+import Codec.Binary.Gray.Bits

@@ -0,0 +1,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) => 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) => 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) => 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) => a -> String+showBits = L.showBits . L.toList

@@ -0,0 +1,57 @@+-- | 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, 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 last).+-- +-- This function is undefined for negative numbers of types that do not+-- have fixed bitsize, like 'Integer'.+toList :: (Bits 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 list of bits in binary encoding to a number.+fromList :: (Bits 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

@@ -2,46 +2,52 @@ module Codec.Binary.Gray_props where  import Test.QuickCheck-import Codec.Binary.Gray+import qualified Codec.Binary.Gray.Bits as B+import qualified Codec.Binary.Gray.List as L  import Data.Bits (testBit, bitSize, Bits)+import Data.Function (on) -prop_num2bin2num_id_Int =-  label "binaryToBits . bitsToBinary == id [Int]" $+---+--- Properties of list-based functions+---++prop_lists_num2bin_id_Int =+  label "fromList . toList == id [Int]" $   forAll (arbitrary :: Gen Int) $ \i ->-      i == (binaryToBits . bitsToBinary $ i)+      i == (L.fromList . L.toList $ i) -prop_num2bin2num_id_Integer =-  label "binaryToBits . bitsToBinary == id [Integer+]" $-  let i = (arbitrary :: Gen Integer) `suchThat` (>= 0)-  in  forAll i (\i -> i == (binaryToBits . bitsToBinary $ i))+prop_lists_num2bin_id_Integer =+  label "fromList . toList == id [Integer+]" $+  let i = (arbitrary :: Gen (NonNegative Integer))+  in  forAll i (\(NonNegative i) -> i == (L.fromList . L.toList $ i)) -prop_correct_bits_Int =-  label "bitsToBinary is correct [Int]" $+prop_lists_correct_bits_Int =+  label "toList is correct [Int]" $   forAll (arbitrary :: Gen Int) $ \i ->       let bts = map (testBit i) [0..(bitSize i)-1]-          padded = (bitsToBinary i) ++ (repeat False)+          padded = (L.toList i) ++ (repeat False)       in  all id $ zipWith (==) bts padded -prop_bin2gray2bin_id =-  label "grayToBinary . binaryToGray == binaryToGray . grayToBinary == id" $+prop_lists_bin2gray_id =+  label "binary . gray == gray . binary == id" $   forAll (listOf $ (arbitrary :: Gen Bool)) $ \bs ->-      bs == (grayToBinary . binaryToGray $ bs) &&-      bs == (binaryToGray . grayToBinary $ bs)+      bs == (L.binary . L.gray $ bs) &&+      bs == (L.gray . L.binary $ bs) -prop_gray_succ_Integer =-  label "Two successive numbers differ in only one bit [Integer+]" $-  let i = (arbitrary :: Gen Integer) `suchThat` (>= 0)-  in  forAll i succ_test+prop_lists_gray_succ_Integer =+  label "hamming x (x+1) == 1 [Integer+]" $+  let i = (arbitrary :: Gen (NonNegative Integer))+  in  forAll i $ \(NonNegative i) -> succ_test i -prop_gray_succ_Int =-  label "Two successive numbers differ in only one bit [Int]" $+prop_lists_gray_succ_Int =+  label "hamming x (x+1) == 1 [Int]" $   let i = (arbitrary :: Gen Int)   in  forAll i succ_test  succ_test :: (Bits a) => a -> Bool succ_test = \i ->-      let n2g = binaryToGray . bitsToBinary+      let n2g = L.gray . L.toList           g1 = n2g i           g2 = n2g (i+1)       in  hamming g1 g2 == 1@@ -57,10 +63,46 @@            then go d xs ys            else go (d+1) xs ys +---+--- Properties of functions for Bits types+---+prop_bits_id = label "binary . gray == gray . binary == id" $+  forAll (arbitrary :: Gen Int) $ \i ->+      (B.binary . B.gray $ i) == i && (B.gray . B.binary $ i) == i++prop_bits_same_as_lists =+  label "bitsToBinary . gray == binaryToGray . bitsToBinary [Int]" $+  forAll (arbitrary :: Gen Int) $ \i ->+      (L.gray . L.toList $ i) == (L.toList . B.gray $ i)++prop_bits_gray_succ_Int = label "hamming x (x+1) == 1 [Int]" $+  forAll (arbitrary :: Gen Int) $ \i ->+      (hammingBits `on` B.gray) i (i+1) == 1+     +prop_bits_gray_succ_Integer = label "hamming x (x+1) == 1 [Integer]" $+  forAll (arbitrary :: Gen (NonNegative Integer)) $ \(NonNegative i) ->+      (hammingBits `on` B.gray) i (i+1) == 1+     +hammingBits :: (Bits a) => a -> a -> Int+hammingBits = hamming `on` L.toList++---+--- Test groups+---++prop_lists = label "[Bool]" $+  prop_lists_num2bin_id_Int .&.+  prop_lists_num2bin_id_Integer .&.+  prop_lists_correct_bits_Int .&.+  prop_lists_bin2gray_id .&.+  prop_lists_gray_succ_Int .&.+  prop_lists_gray_succ_Integer++prop_bits = label "Bits" $+  prop_bits_id .&.+  prop_bits_same_as_lists .&.+  prop_bits_gray_succ_Int .&.+  prop_bits_gray_succ_Integer+ all_props =-  prop_num2bin2num_id_Int .&.-  prop_num2bin2num_id_Integer .&.-  prop_correct_bits_Int .&.-  prop_bin2gray2bin_id .&.-  prop_gray_succ_Int .&.-  prop_gray_succ_Integer+  prop_lists .&. prop_bits

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1+Version:             0.2  -- A short (one-line) description of the package. Synopsis:            Gray code encoder/decoder.@@ -15,8 +15,12 @@ -- A longer description of the package. Description:    Gray code is a binary numeral system where two successive numbers-   differ in only one bit. This package allows to convert Haskell-   numbers to one of the possible Gray codes and back.+   differ in only one bit.+   .+   This package allows to convert numbers to one of the possible Gray+   codes and back. Two binary representations of a number are supported:+   @[Bool]@ and types of @Bits@ type class.+   @Bits@ is the default implementation.  -- URL for the project homepage or repository. Homepage:            http://bitbucket.org/jetxee/hs-gray-code@@ -57,6 +61,8 @@   -- Modules exported by the library.   Exposed-modules:      Codec.Binary.Gray+     , Codec.Binary.Gray.Bits+     , Codec.Binary.Gray.List    -- Packages needed in order to build this package.   Build-depends: