Commits

Aleksey Khudyakov  committed d275182

Replace tests for uniformity with a more generic framework for
chi squared tests. It's required for testing of condensed tables

  • Participants
  • Parent commits 25674d4

Comments (0)

Files changed (3)

File test/ChiSquare.hs

+{-# LANGUAGE RecordWildCards #-}
+-- Chi square tests for random generators
+module ChiSquare ( 
+  tests
+  ) where
+
+import Control.Applicative
+import Control.Monad
+
+import Data.Typeable
+import Data.Word
+import qualified Data.Vector.Unboxed         as U
+import qualified Data.Vector.Unboxed.Mutable as M
+import qualified System.Random.MWC           as MWC
+
+import Statistics.Test.ChiSquared
+
+import Test.HUnit hiding (Test)
+import Test.Framework
+import Test.Framework.Providers.HUnit
+
+----------------------------------------------------------------
+
+tests :: MWC.GenIO -> Test
+tests g = testGroup "Chi squared tests" 
+    -- Word8 tests
+  [ uniformRTest (0,255 :: Word8) g
+  , uniformRTest (0,254 :: Word8) g
+  , uniformRTest (0,129 :: Word8) g
+  , uniformRTest (0,126 :: Word8) g
+  , uniformRTest (0,10  :: Word8) g
+    -- * Tables
+  ]
+
+----------------------------------------------------------------
+-- | RNG and corresonding distribution
+data Generator = Generator {
+    generator    :: MWC.GenIO -> IO Int
+  , probabilites :: U.Vector Double
+  }
+
+-- | Apply chi square test for a distribution
+sampleTest :: Generator           -- ^ Generator to test
+           -> Int                 -- ^ N of events
+           -> MWC.GenIO           -- ^ PRNG state
+           -> IO TestResult
+sampleTest (Generator{..}) n g = do
+  let size = U.length $ probabilites
+  h <- histogram (generator g) size n
+  let w = U.map (* fromIntegral n) probabilites
+  return $ chi2test 0.05 0 $ U.zip h w
+{-# INLINE sampleTest #-}
+
+  
+-- | Fill histogram using supplied generator
+histogram :: IO Int             -- ^ Rangom generator
+          -> Int                -- ^ N of outcomes 
+          -> Int                -- ^ N of events
+          -> IO (U.Vector Int)
+histogram gen size n = do
+  arr <- M.replicate size 0
+  replicateM_ n $ do i <- gen
+                     when (i < size) $ M.write arr i . (+1) =<< M.read arr i
+  U.unsafeFreeze arr
+{-# INLINE histogram #-}
+
+
+uniformRTest :: (MWC.Variate a, Typeable a, Show a, Integral a) => (a,a) -> MWC.GenIO -> Test
+uniformRTest (a,b) g = 
+  testCase ("uniformR: " ++ show (a,b) ++ " :: " ++ show (typeOf a)) $ do
+    let n   = fromIntegral b - fromIntegral a + 1
+        gen = Generator { generator    = \g -> fromIntegral . subtract a <$> MWC.uniformR (a,b) g
+                        , probabilites = U.replicate n (1 / fromIntegral n)
+                        }
+    r <- sampleTest gen (10^5) g
+    assertEqual "Significant!" NotSignificant r
+{-# INLINE uniformRTest #-}

File test/Uniform.hs

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

File test/tests.hs

 import System.Random.MWC    (withSystemRandom)
 
 import qualified QC
-import qualified Uniform
+import qualified ChiSquare
 import qualified KS
 
 
   withSystemRandom $ \g -> 
     defaultMain
     [ QC.tests      g
-    , Uniform.tests g
+    , ChiSquare.tests g
     , KS.tests      g
-    ]
+    ]