gray-extended 1.5 → 1.5.1

raw patch · 2 files changed

+98/−4 lines, 2 filesdep ~QuickCheckdep ~test-frameworkPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, test-framework

API changes (from Hackage documentation)

Files

• gray-extended.cabal +13/−4
• test/Codec/GrayQC.hs +85/−0

@@ -1,5 +1,5 @@ name:           gray-extended-version:        1.5+version:        1.5.1 synopsis:       Gray encoding schemes description:    Gray codes satisfy the property that two successive values                  differ in only one digit. Usually the term \"Gray code\"@@ -16,6 +16,15 @@ maintainer:     amy@nualeargais.ie license-file:   LICENSE +source-repository head+  type:     git+  location: https://github.com/mhwombat/gray-extended.git++source-repository this+  type:     git+  location: https://github.com/mhwombat/gray-extended.git+  tag:      1.5.1+ library   hs-source-dirs:  src   build-depends:   base ==4.*@@ -26,10 +35,10 @@   type:            exitcode-stdio-1.0   build-depends:   base ==4.*,                    test-framework-quickcheck2 == 0.3.*,-                   QuickCheck == 2.4.*,-                   test-framework == 0.*,+                   QuickCheck == 2.7.*,+                   test-framework == 0.8.*,                    gray-extended   hs-source-dirs:  test   ghc-options:     -Wall -Werror -rtsopts   main-is:         Main.hs-+  other-modules:   Codec.GrayQC

@@ -0,0 +1,85 @@+module Codec.GrayQC+  (+    test+  ) where++import Codec.Gray+import Data.List (nub)+import Data.Word (Word8)+import Test.Framework as TF (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck ((==>), Property, Gen, Arbitrary, arbitrary, choose, +  property, sized)++prop_successive_values_differ_in_one_place1 :: Int -> Property+prop_successive_values_differ_in_one_place1 k = k > 0 ==>+  nub (diffCounts xs) == [1]+    where xs = grayCodes k'+          k' = min 10 k -- avoid long tests++data TestParms = TestParms String Int deriving Show++sizedTestParms :: Int -> Gen TestParms+sizedTestParms n = do+  let n' = 2 + (min 8 n) -- keep number of digits and bits low to speed up tests+  let digits = take n' ['a' .. 'z']+  k <- choose (1,min 4 (n+1))+  return $ TestParms digits k++instance Arbitrary TestParms where+  arbitrary = sized sizedTestParms+  +prop_successive_values_differ_in_one_place2 :: TestParms -> Property+prop_successive_values_differ_in_one_place2 (TestParms ds k) = property $+  nub (diffCounts xs) == [1]+    where xs = naryGrayCodes ds k++diffCounts :: Eq b => [[b]] -> [Int]+diffCounts [] = []+diffCounts [_] = []+diffCounts (x1:x2:xs) = (diffCount x1 x2) : diffCounts (x2:xs)++diffCount :: Eq b => [b] -> [b] -> Int+diffCount as bs = length $ filter (\x -> x) $ zipWith (/=) as bs++prop_encoding_round_trippable :: Int -> Property+prop_encoding_round_trippable n =+  n >= 0 ==> (grayToIntegral . integralToGray $ n) == n++prop_decoding_round_trippable :: Int -> Property+prop_decoding_round_trippable n =+  n >= 0 ==> (integralToGray . grayToIntegral $ n) == n++prop_integralToGray_same_as_encode :: Word8 -> Property+prop_integralToGray_same_as_encode n =+  property $ integralToGray n == boolsToIntegral bits+    where bits = (grayCodes 8) !! (fromIntegral n)++boolsToIntegral :: Num c => [Bool] -> c+boolsToIntegral bs = f 0 1 . reverse $ bs+  where f total _ [] = total+        f total factor (b:bs') = f total' (factor*2) bs'+          where total' = if b then total + factor else total+                +-- integralToBools :: (Integral a, Bits a) => a -> [Bool]+-- integralToBools 0 = []+-- integralToBools n = integralToBools (n `shiftR` 1) ++ [f (n `mod` 2)]+--   where f 0 = False+--         f 1 = True++test :: Test+test = testGroup "Codec.GrayQC"+  [+    testProperty "prop_successive_values_differ_in_one_place1"+      prop_successive_values_differ_in_one_place1,+    testProperty "prop_successive_values_differ_in_one_place2"+      prop_successive_values_differ_in_one_place2,+    testProperty "prop_encoding_round_trippable"+      prop_encoding_round_trippable,+    testProperty "prop_decoding_round_trippable"+      prop_decoding_round_trippable,+    testProperty "prop_integralToGray_same_as_encode"+      prop_integralToGray_same_as_encode+  ]++