# HG changeset patch
# User Sergey Astanin
# Date 1279658271 7200
# Node ID 3f490c5dbfce55e9f45286733357342866174488
# Parent 8d4ff2a2f2d121c15db2aa466b3cb2223ef555f5
Split into Codec.Binary.Gray.Bits and Codec.Binary.Gray.List (API changed)
diff git a/Codec/Binary/Gray.hs b/Codec/Binary/Gray.hs
 a/Codec/Binary/Gray.hs
+++ b/Codec/Binary/Gray.hs
@@ 1,108 +1,4 @@
  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' (s1)
  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 01 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
\ No newline at end of file
diff git a/Codec/Binary/Gray/Bits.hs b/Codec/Binary/Gray/Bits.hs
new file mode 100644
 /dev/null
+++ b/Codec/Binary/Gray/Bits.hs
@@ 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' (s1)
+  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
diff git a/Codec/Binary/Gray/List.hs b/Codec/Binary/Gray/List.hs
new file mode 100644
 /dev/null
+++ b/Codec/Binary/Gray/List.hs
@@ 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
diff git a/Codec/Binary/Gray_props.hs b/Codec/Binary/Gray_props.hs
 a/Codec/Binary/Gray_props.hs
+++ b/Codec/Binary/Gray_props.hs
@@ 2,7 +2,8 @@
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)
@@ 12,32 +13,32 @@

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]" $
@@ 46,7 +47,7 @@
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
@@ 67,22 +68,23 @@

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
diff git a/graycode.cabal b/graycode.cabal
 a/graycode.cabal
+++ b/graycode.cabal
@@ 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 (oneline) 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/hsgraycode
@@ 57,6 +61,8 @@
 Modules exported by the library.
Exposedmodules:
Codec.Binary.Gray
+ , Codec.Binary.Gray.Bits
+ , Codec.Binary.Gray.List
 Packages needed in order to build this package.
Builddepends: