diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Changelog for gray-extended + +1.5.3 Upgrade to work with Stack 1.9.3 + +## Unreleased changes diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright Amy de Buitléir (c) 2010-2016 +Copyright Amy de Buitléir (c) 2010-2018 All rights reserved. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +gray-extended +============= + +Tools for generating Gray codes. diff --git a/gray-extended.cabal b/gray-extended.cabal --- a/gray-extended.cabal +++ b/gray-extended.cabal @@ -1,41 +1,56 @@ -name: gray-extended -version: 1.5.2 -synopsis: Gray encoding schemes -description: Gray codes satisfy the property that two successive values - differ in only one digit. Usually the term \"Gray code\" - refers to the Binary Reflected Gray code (BRGC), but - non-binary Gray codes have also been discovered. -homepage: https://github.com/mhwombat/gray-extended#readme -bug-reports: https://github.com/mhwombat/gray-extended/issues -license: BSD3 -license-file: LICENSE -author: Amy de Buitléir -maintainer: amy@nualeargais.ie -copyright: (c) Amy de Buitléir 2010-2016 -category: Math -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 +cabal-version: 1.12 -library - hs-source-dirs: src - exposed-modules: Codec.Gray - ghc-options: -Wall - build-depends: base >= 4.7 && < 5 - default-language: Haskell2010 +-- This file has been generated from package.yaml by hpack version 0.31.1. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 4728446479b06872d39a08ea9db544dc544d7e99f62c2d6a038f53ca1f739304 -test-suite gray-extended-test - type: exitcode-stdio-1.0 - hs-source-dirs: test - main-is: TestMain.hs - build-depends: base, - gray-extended, - test-framework ==0.8.*, - test-framework-quickcheck2 ==0.3.*, - QuickCheck ==2.7.* || ==2.8.* || ==2.9.* - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - default-language: Haskell2010 +name: gray-extended +version: 1.5.3 +synopsis: Gray encoding schemes +description: Please see the README on GitHub at +category: Math +homepage: https://github.com/mhwombat/gray-extended#readme +bug-reports: https://github.com/mhwombat/gray-extended/issues +author: Amy de Buitléir +maintainer: amy@nualeargais.ie +copyright: 2018 Amy de Buitléir +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md source-repository head - type: git + type: git location: https://github.com/mhwombat/gray-extended + +library + exposed-modules: + Codec.Gray + other-modules: + Paths_gray_extended + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + default-language: Haskell2010 + +test-suite gray-extended-test + type: exitcode-stdio-1.0 + main-is: TestMain.hs + other-modules: + Codec.GrayQC + Paths_gray_extended + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck + , base >=4.7 && <5 + , gray-extended + , test-framework + , test-framework-quickcheck2 + default-language: Haskell2010 diff --git a/test/Codec/GrayQC.hs b/test/Codec/GrayQC.hs new file mode 100644 --- /dev/null +++ b/test/Codec/GrayQC.hs @@ -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 + ] + +