Commits

Aleksey Khudyakov committed 54f2464

Port test suite to test-framework

It doesn't work with cabal.

Comments (0)

Files changed (5)

 test-suite tests
   type:           exitcode-stdio-1.0
   hs-source-dirs: test
-  main-is:        QC.hs
+  main-is:        tests.hs
+  other-modules:  QC
+                  Uniform
 
   ghc-options:
     -Wall -threaded -rtsopts
 
   build-depends:
+    base,
     QuickCheck,
-    base,
+    HUnit,
+    test-framework,
+    test-framework-hunit,
+    test-framework-quickcheck2,
+    statistics,
     mwc-random
 
 source-repository head
 -- QC tests for random number generators
 --
 -- Require QuickCheck >= 2.2
+module QC (
+  tests
+  ) where
 
 import Control.Applicative
-import Test.QuickCheck
-import Test.QuickCheck.Monadic
-import System.Random.MWC
 
 import Data.Word (Word8,Word16,Word32,Word64,Word)
 import Data.Int  (Int8, Int16, Int32, Int64 )
 
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
 
+import System.Random.MWC
 
--- Ordered pair (x,y) for which x <= y
-newtype OrderedPair a = OrderedPair (a,a)
-                        deriving Show
-instance (Ord a, Arbitrary a) => Arbitrary (OrderedPair a) where
-  arbitrary = OrderedPair <$> suchThat arbitrary (\(x,y) -> x <= y)
 
 
 ----------------------------------------------------------------
+
+tests :: GenIO -> Test
+tests g = testGroup "Range"
+  [ testProperty "Int8"   $ (prop_InRange g :: InRange Int8)
+  , testProperty "Int16"  $ (prop_InRange g :: InRange Int16)
+  , testProperty "Int32"  $ (prop_InRange g :: InRange Int32)
+  , testProperty "Int64"  $ (prop_InRange g :: InRange Int64)
+  , testProperty "Word8"  $ (prop_InRange g :: InRange Word8)
+  , testProperty "Word16" $ (prop_InRange g :: InRange Word16)
+  , testProperty "Word32" $ (prop_InRange g :: InRange Word32)
+  , testProperty "Word64" $ (prop_InRange g :: InRange Word64)
+  , testProperty "Int"    $ (prop_InRange g :: InRange Int)
+  , testProperty "Word64" $ (prop_InRange g :: InRange Word)
+  , testProperty "Float"  $ (prop_InRange g :: InRange Float)
+  , testProperty "Double" $ (prop_InRange g :: InRange Double)
+  ]
+
+
+
+----------------------------------------------------------------
+
 -- Test that values generated with uniformR never lie outside range.
-
-prop_InRange :: (Variate a, Ord a) => GenIO -> OrderedPair a -> Property
+prop_InRange :: (Variate a, Ord a,Num a) => GenIO -> OrderedPair a -> Property
 prop_InRange g (OrderedPair (x1,x2)) = monadicIO $ do
   r <- run $ uniformR (x1,x2) g
   assert (x1 <= r && r <= x2)
 
 type InRange a = OrderedPair a -> Property
 
-test_InRange :: IO ()
-test_InRange = withSystemRandom $ \g -> do
-  -- Run really lot of tests in order to catch corner cases
-  let q :: (Testable prop) => prop -> IO ()
-      q = quickCheckWith stdArgs { maxSuccess = 10000
-                                 , chatty     = False -- Don't print anything. Too slow
-                                 }
-  putStrLn "Int8"   >> q (prop_InRange g :: InRange Int8)
-  putStrLn "Int16"  >> q (prop_InRange g :: InRange Int16)
-  putStrLn "Int32"  >> q (prop_InRange g :: InRange Int32)
-  putStrLn "Int64"  >> q (prop_InRange g :: InRange Int64)
-  putStrLn "Word8"  >> q (prop_InRange g :: InRange Word8)
-  putStrLn "Word16" >> q (prop_InRange g :: InRange Word16)
-  putStrLn "Word32" >> q (prop_InRange g :: InRange Word32)
-  putStrLn "Word64" >> q (prop_InRange g :: InRange Word64)
-  putStrLn "Int"    >> q (prop_InRange g :: InRange Int)
-  putStrLn "Word64" >> q (prop_InRange g :: InRange Word)
-  putStrLn "Float"  >> q (prop_InRange g :: InRange Float)
-  putStrLn "Double" >> q (prop_InRange g :: InRange Double)
-
-main :: IO ()
-main = test_InRange
+-- Ordered pair (x,y) for which x <= y
+newtype OrderedPair a = OrderedPair (a,a)
+                        deriving Show
+instance (Ord a, Arbitrary a) => Arbitrary (OrderedPair a) where
+  arbitrary = OrderedPair <$> suchThat arbitrary (uncurry (<=))
+-- Tests for testing uniformity of distributions
+module Uniform (
+  tests
+  ) where
+
+import Data.Word
+import Data.Int
+import Data.Typeable
+import qualified Data.Vector.Generic         as G
+import qualified Data.Vector.Unboxed         as U
+import qualified Data.Vector.Unboxed.Mutable as M
+
+import Statistics.Distribution
+import Statistics.Distribution.ChiSquared
+import Statistics.Test.ChiSquared
+
+import System.Random.MWC
+
+import Test.HUnit hiding (Test)
+import Test.Framework
+import Test.Framework.Providers.HUnit
+
+import Text.Printf
+
+
+tests :: GenIO -> Test
+tests g = testGroup "Uniformity" 
+  [ testUniformity g (0,255 :: Word8 )
+  , testUniformity g (0,254 :: Word8 )
+  , testUniformity g (0,10  :: Word8 )
+  ]
+
+
+----------------------------------------------------------------
+
+-- Test that uniformR is uniform using Chi-2 test
+testUniformity :: (Variate a, U.Unbox a, Integral a, Typeable a, Show a) => GenIO -> (a,a) -> Test
+testUniformity g (a,b) = 
+  testCase ("uniformity " ++ show (typeOf a) ++ " " ++ show (a,b)) $ do
+    let n = 10000
+    vec <- fill n (a,b) g
+    case chi2test 0.05 0 $ U.map (\x -> (x, fromIntegral n)) vec of
+      Significant    -> assertFailure "Not uniform!"
+      NotSignificant -> return ()
+
+
+-- Fill vector with number of occurences of random number in range.
+-- Uses uniformR for generation of random numbers
+fill :: (Variate a, U.Unbox a, Integral a) => 
+        Int                     -- Expected number of items in each bin
+     -> (a,a)                   -- Range for values
+     -> GenIO                   -- Generator
+     -> IO (U.Vector Int)
+fill n rng@(x1,x2) g = do
+  let l = fromIntegral x2 - fromIntegral x1 + 1
+  v <- M.replicate l 0
+  let loop k | k == n*l  = return ()
+             | otherwise = do x <- fromIntegral `fmap` uniformR rng g
+                              M.write v x . (+1) =<< M.read v x
+                              loop (k+1)
+  loop 0
+  G.unsafeFreeze v
+import Test.Framework       (defaultMain)
+import System.Random.MWC    (withSystemRandom)
+
+import qualified QC
+import qualified Uniform
+
+
+
+main :: IO ()
+main = 
+  withSystemRandom $ \g -> 
+    defaultMain
+    [ QC.tests      g
+    , Uniform.tests g
+    ]

test/uniform.hs

--- Tests for testing uniformity of distributions
---
--- Require statistics >= 0.7
-
-{-# LANGUAGE BangPatterns #-}
-
-import Data.Word
-import Data.Int
-import qualified Data.Vector.Generic         as G
-import qualified Data.Vector.Unboxed         as U
-import qualified Data.Vector.Unboxed.Mutable as M
-
-import Statistics.Distribution
-import Statistics.Distribution.ChiSquared
-
-import System.Random.MWC
-
-import Text.Printf
-
-
--- Fill vector with number of occurences of random number in range.
--- Uses uniformR for generation of random numbers
-fill :: (Variate a, U.Unbox a, Integral a) => 
-        Int                     -- Expected number of items in each bin
-     -> (a,a)                   -- Range for values
-     -> GenIO                   -- Generator
-     -> IO (U.Vector Int)
-fill n rng@(x1,x2) g = do
-  let l = fromIntegral x2 - fromIntegral x1 + 1
-  v <- M.newWith l 0
-  let loop k | k == n*l  = return ()
-             | otherwise = do x <- fromIntegral `fmap` uniformR rng g
-                              M.write v x . (+1) =<< M.read v x
-                              loop (k+1)
-  loop 0
-  G.unsafeFreeze v
-
--- Calculate χ² statistics for vector of number occurences for
--- hypotheshys that each bin has equal probability
-chi2uniform :: U.Vector Int -> Double
-chi2uniform v = (U.sum $ U.map (sqr . subtract μ . fromIntegral) v) / μ 
-  where
-    n   = U.length v
-    tot = U.sum v
-    μ   = fromIntegral tot / fromIntegral n
-    sqr x = x * x
-
--- Perform χ² on vector of number of occurences
-checkChi2 :: Double             -- Desired significance level
-          -> U.Vector Int       -- Vector of values
-          -> IO ()
-checkChi2 p v = do
-  let χ2   = chi2uniform v      -- Observed χ²
-      ndf  = U.length v - 1     -- N degrees of freedom
-      d    = chiSquared ndf     -- Theoretical distribution
-      pLow = cumulative d χ2
-      pHi  = 1 - pLow
-  
-  putStrLn $ if pLow > p && (1-pLow) > p then "OK" else "* FAILED *"
-  printf "  significance = %.3f\n"   p
-  printf "  χ²/ndf = %.3f\n"        (χ2 / fromIntegral ndf)
-  printf "  p(χ² < observed) = %.3g\n" pLow
-  printf "  p(χ² > observed) = %.3g\n" pHi
-
-
-main :: IO ()
-main = do
-  putStrLn "(0,255) Word8"
-  v1 <- withSystemRandom $ fill 10000 (0,255 :: Word8)
-  checkChi2 0.05 v1
-  checkChi2 0.01 v1
-  putStrLn ""
-  ----------------------------------------
-  putStrLn "(0,254) Word8"
-  v1 <- withSystemRandom $ fill 10000 (0,254 :: Word8)
-  checkChi2 0.05 v1
-  checkChi2 0.01 v1
-  putStrLn ""
-  ----------------------------------------
-  putStrLn "(0,10) Word8"
-  v1 <- withSystemRandom $ fill 10000 (0,10 :: Word8)
-  checkChi2 0.05 v1
-  checkChi2 0.01 v1
-  putStrLn ""