Commits

Sergey Astanin  committed 3f490c5

Split into Codec.Binary.Gray.Bits and Codec.Binary.Gray.List (API changed)

  • Participants
  • Parent commits 8d4ff2a
  • Tags 0.2

Comments (0)

Files changed (5)

File Codec/Binary/Gray.hs

--- | 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
+    ( module Codec.Binary.Gray.Bits ) 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
+import Codec.Binary.Gray.Bits

File Codec/Binary/Gray/Bits.hs

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

File Codec/Binary/Gray/List.hs

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

File Codec/Binary/Gray_props.hs

 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_lists_num2bin_id_Int =
-  label "binaryToBits . bitsToBinary == id [Int]" $
+  label "fromList . toList == id [Int]" $
   forAll (arbitrary :: Gen Int) $ \i ->
-      i == (binaryToBits . bitsToBinary $ i)
+      i == (L.fromList . L.toList $ i)
 
 prop_lists_num2bin_id_Integer =
-  label "binaryToBits . bitsToBinary == id [Integer+]" $
+  label "fromList . toList == id [Integer+]" $
   let i = (arbitrary :: Gen (NonNegative Integer))
-  in  forAll i (\(NonNegative i) -> i == (binaryToBits . bitsToBinary $ i))
+  in  forAll i (\(NonNegative i) -> i == (L.fromList . L.toList $ i))
 
 prop_lists_correct_bits_Int =
-  label "bitsToBinary is correct [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_lists_bin2gray_id =
-  label "grayToBinary . binaryToGray == binaryToGray . grayToBinary == 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_lists_gray_succ_Integer =
   label "hamming x (x+1) == 1 [Integer+]" $
-  let i = (arbitrary :: Gen Integer) `suchThat` (>= 0)
-  in  forAll i succ_test
+  let i = (arbitrary :: Gen (NonNegative Integer))
+  in  forAll i $ \(NonNegative i) -> succ_test i
 
 prop_lists_gray_succ_Int =
   label "hamming x (x+1) == 1 [Int]" $
 
 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
 ---
 prop_bits_id = label "binary . gray == gray . binary == id" $
   forAll (arbitrary :: Gen Int) $ \i ->
-      (binary . gray $ i) == i && (gray . binary $ i) == 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 ->
-      (binaryToGray . bitsToBinary $ i) == (bitsToBinary . gray $ 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` gray) i (i+1) == 1
+  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` gray) i (i+1) == 1
+      (hammingBits `on` B.gray) i (i+1) == 1
      
 hammingBits :: (Bits a) => a -> a -> Int
-hammingBits = hamming `on` bitsToBinary
+hammingBits = hamming `on` L.toList
 
 ---
 --- Test groups

File gray-code.cabal

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