diff --git a/Data/Bits/Ordered/QuickCheck.hs b/Data/Bits/Ordered/QuickCheck.hs deleted file mode 100644 --- a/Data/Bits/Ordered/QuickCheck.hs +++ /dev/null @@ -1,74 +0,0 @@ - -{-# Options_GHC -O0 #-} - --- | Check a number of properties for popcount-ordered elements. --- --- $setup --- --- >>> :set -XScopedTypeVariables --- - -module Data.Bits.Ordered.QuickCheck where - -import Test.QuickCheck hiding ((.&.)) -import Data.Int (Int16(..)) -import Data.Bits -import qualified Data.Vector.Unboxed as VU -import Data.List (groupBy,sort,permutations,nub) -import Data.Function (on) -import Data.Maybe (isJust) -import Control.Monad (join) -import Debug.Trace -import Data.Word (Word) - -import Data.Bits.Ordered - - - --- | Check if both the memoized version and the population enumeration --- produce the same multisets, but maybe in different order. --- --- prop> \(n :: Int16) -> let b = popCount n in memoSorted b == enumSorted b --- - -prop_PopCountSet (NonZero (n :: Int16)) = memo == enum - where b = popCount n - memo = memoSorted b - enum = enumSorted b - -memoSorted, enumSorted :: Int -> [[Int]] - -memoSorted b = map sort . groupBy ((==) `on` popCount) $ VU.toList $ popCntMemoInt b -enumSorted b = map sort $ [0] : [ roll (popPermutation b) (Just $ 2^k-1) | k <- [1..b] ] - where roll f (Just k) = k : roll f (f k) - roll _ Nothing = [] - -prop_lsb_Int (x :: Int) = lsbZ x == maybe (-1) id (maybeLsb x) - -prop_lsb_Word (x :: Word) = lsbZ x == maybe (-1) id (maybeLsb x) - -prop_OneBits_Int (x :: Int) = popCount x == length abl && and [ testBit x k | k <- abl ] - where abl = activeBitsL x - --- Tests if we actually generate all permutations. - -prop_allPermutations (a :: Int , b :: Int) = and $ zipWith cmp (sort qs) (sort $ nub ps) - where nbs = min a' b' -- number of 1 bits in set - sts = max a' b' -- set size - a' = a `mod` 8 -- finiteBitSize a - b' = b `mod` 8 -- finiteBitSize b - ps = permutations $ replicate (sts - nbs) False ++ replicate nbs True - qs = go (Just $ 2 ^ nbs - 1) - go :: Maybe Int -> [Int] - go Nothing = [] - go (Just k) = k : go (popPermutation sts k) - cmp k as = and [ if a then testBit k c else (not $ testBit k c) | (a,c) <- zip (reverse as) [0 .. ] ] - --- TODO popComplement - -prop_popShiftL_popShiftR (a::Word,b::Word) = s == l - where m = a .|. b - s = a .&. b - l = popShiftL m r - r = popShiftR m s - diff --git a/OrderedBits.cabal b/OrderedBits.cabal --- a/OrderedBits.cabal +++ b/OrderedBits.cabal @@ -1,5 +1,5 @@ name: OrderedBits -version: 0.0.0.3 +version: 0.0.1.0 author: Christian Hoener zu Siederdissen copyright: Christian Hoener zu Siederdissen, 2014 - 2015 homepage: https://github.com/choener/OrderedBits @@ -34,7 +34,6 @@ build-depends: base >= 4.7 && < 4.9 , bits >= 0.4 && < 0.5 , primitive >= 0.5 && < 0.7 - , QuickCheck >= 2.7 && < 2.9 , vector >= 0.10 && < 0.12 , vector-algorithms >= 0.6 && < 0.7.1 default-language: @@ -46,17 +45,16 @@ , ScopedTypeVariables exposed-modules: Data.Bits.Ordered - Data.Bits.Ordered.QuickCheck ghc-options: -O2 -funbox-strict-fields benchmark BenchmarkOrderedBits - build-depends: base - , criterion >= 1.0.2 && < 1.1.1 - , OrderedBits - , vector + build-depends: base + , criterion >= 1.0.2 && < 1.1.1 + , OrderedBits + , vector default-language: Haskell2010 hs-source-dirs: @@ -83,12 +81,15 @@ default-language: Haskell2010 default-extensions: TemplateHaskell + , ScopedTypeVariables build-depends: base , OrderedBits , QuickCheck + , QuickCheck >= 2.7 && < 2.9 , test-framework >= 0.8 && < 0.9 , test-framework-quickcheck2 >= 0.3 && < 0.4 , test-framework-th >= 0.2 && < 0.3 + , vector diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,8 @@ +0.0.1.0 +------- + +- moved all properties directly into tests/properties.hs + 0.0.0.3 ------- diff --git a/tests/properties.hs b/tests/properties.hs --- a/tests/properties.hs +++ b/tests/properties.hs @@ -1,19 +1,71 @@ module Main where +import Control.Monad (join) +import Data.Bits +import Data.Function (on) +import Data.Int (Int16(..)) +import Data.List (groupBy,sort,permutations,nub) +import Data.Maybe (isJust) +import Data.Word (Word) +import Debug.Trace +import qualified Data.Vector.Unboxed as VU import Test.Framework.Providers.QuickCheck2 import Test.Framework.TH +import Test.QuickCheck hiding ((.&.)) -import qualified Data.Bits.Ordered.QuickCheck as QC +import Data.Bits.Ordered -prop_PopCountSet = QC.prop_PopCountSet -prop_lsb_Int = QC.prop_lsb_Int -prop_lsb_Word = QC.prop_lsb_Word -prop_OneBits_Int = QC.prop_OneBits_Int -prop_allPermutations = QC.prop_allPermutations -prop_popShiftL_popShiftR = QC.prop_popShiftL_popShiftR +-- | Check if both the memoized version and the population enumeration +-- produce the same multisets, but maybe in different order. +-- +-- prop> \(n :: Int16) -> let b = popCount n in memoSorted b == enumSorted b +-- + +prop_PopCountSet (NonZero (n :: Int16)) = memo == enum + where b = popCount n + memo = memoSorted b + enum = enumSorted b + +memoSorted, enumSorted :: Int -> [[Int]] + +memoSorted b = map sort . groupBy ((==) `on` popCount) $ VU.toList $ popCntMemoInt b +enumSorted b = map sort $ [0] : [ roll (popPermutation b) (Just $ 2^k-1) | k <- [1..b] ] + where roll f (Just k) = k : roll f (f k) + roll _ Nothing = [] + +prop_lsb_Int (x :: Int) = lsbZ x == maybe (-1) id (maybeLsb x) + +prop_lsb_Word (x :: Word) = lsbZ x == maybe (-1) id (maybeLsb x) + +prop_OneBits_Int (x :: Int) = popCount x == length abl && and [ testBit x k | k <- abl ] + where abl = activeBitsL x + +-- Tests if we actually generate all permutations. + +prop_allPermutations (a :: Int , b :: Int) = and $ zipWith cmp (sort qs) (sort $ nub ps) + where nbs = min a' b' -- number of 1 bits in set + sts = max a' b' -- set size + a' = a `mod` 8 -- finiteBitSize a + b' = b `mod` 8 -- finiteBitSize b + ps = permutations $ replicate (sts - nbs) False ++ replicate nbs True + qs = go (Just $ 2 ^ nbs - 1) + go :: Maybe Int -> [Int] + go Nothing = [] + go (Just k) = k : go (popPermutation sts k) + cmp k as = and [ if a then testBit k c else (not $ testBit k c) | (a,c) <- zip (reverse as) [0 .. ] ] + +-- TODO popComplement + +prop_popShiftL_popShiftR (a::Word,b::Word) = s == l + where m = a .|. b + s = a .&. b + l = popShiftL m r + r = popShiftR m s + + main :: IO () main = $(defaultMainGenerator)