packages feed

gray-code (empty) → 0.1

raw patch · 5 files changed

+237/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

+ Codec/Binary/Gray.hs view
@@ -0,0 +1,60 @@+-- | 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..])++-- | 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
+ Codec/Binary/Gray_props.hs view
@@ -0,0 +1,66 @@+-- | QuickCheck properties of Codec.Binary.Gray module.+module Codec.Binary.Gray_props where++import Test.QuickCheck+import Codec.Binary.Gray++import Data.Bits (testBit, bitSize, Bits)++prop_num2bin2num_id_Int =+  label "binaryToBits . bitsToBinary == id [Int]" $+  forAll (arbitrary :: Gen Int) $ \i ->+      i == (binaryToBits . bitsToBinary $ 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_correct_bits_Int =+  label "bitsToBinary is correct [Int]" $+  forAll (arbitrary :: Gen Int) $ \i ->+      let bts = map (testBit i) [0..(bitSize i)-1]+          padded = (bitsToBinary i) ++ (repeat False)+      in  all id $ zipWith (==) bts padded++prop_bin2gray2bin_id =+  label "grayToBinary . binaryToGray == binaryToGray . grayToBinary == id" $+  forAll (listOf $ (arbitrary :: Gen Bool)) $ \bs ->+      bs == (grayToBinary . binaryToGray $ bs) &&+      bs == (binaryToGray . grayToBinary $ 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_gray_succ_Int =+  label "Two successive numbers differ in only one bit [Int]" $+  let i = (arbitrary :: Gen Int)+  in  forAll i succ_test++succ_test :: (Bits a) => a -> Bool+succ_test = \i ->+      let n2g = binaryToGray . bitsToBinary+          g1 = n2g i+          g2 = n2g (i+1)+      in  hamming g1 g2 == 1++hamming :: [Bool] -> [Bool] -> Int+hamming xs ys = go 0 xs ys+  where+    go d [] [] = d+    go d [] ys = go d [False] ys  -- extension for different lengths+    go d xs [] = go d [False] xs+    go d (x:xs) (y:ys) =+        if x == y+           then go d xs ys+           else go (d+1) xs ys++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
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Sergey Astanin 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Sergey Astanin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,11 @@+#!/usr/bin/env runhaskell+import Distribution.Simple++import Test.QuickCheck+import Codec.Binary.Gray_props++main = defaultMainWithHooks $+       simpleUserHooks { runTests = tests }++tests _ _ _ _ = +    quickCheckWith (stdArgs {maxSuccess = 1000}) all_props
+ gray-code.cabal view
@@ -0,0 +1,70 @@+-- gray-code.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                gray-code++-- 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++-- 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.++-- URL for the project homepage or repository.+Homepage:            http://bitbucket.org/jetxee/hs-gray-code++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Sergey Astanin++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          s.astanin@gmail.com++-- A copyright notice.+-- Copyright:           ++-- Stability of the pakcage (experimental, provisional, stable...)+Stability:           Experimental++Category:            Codec++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files:+     Codec/Binary/Gray_props.hs++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2+++Library+  -- Modules exported by the library.+  Exposed-modules:+     Codec.Binary.Gray++  -- Packages needed in order to build this package.+  Build-depends:+     base >= 3 && < 5+  +  -- Modules not exported by this package.+  -- Other-modules:+  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +