Gray_props.hs

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