1module Main (main) where 2 3import Data.Bits ((.&.)) 4import Data.Int (Int64) 5import Data.Word (Word64) 6import Test.Framework (defaultMain, testGroup) 7 8import qualified System.Random.SplitMix as SM 9import qualified System.Random.SplitMix32 as SM32 10 11import MiniQC (Arbitrary (..), Gen (..), counterexample, testMiniProperty) 12import Uniformity 13 14main :: IO () 15main = defaultMain 16 [ testUniformity "SM64 uniformity" (arbitrary :: Gen Word64) (.&. 0xf) 16 17 , testUniformity "SM64 uniformity" (arbitrary :: Gen Word64) (.&. 0xf0) 16 18 19 , testUniformity "bitmaskWithRejection uniformity" (arbitrary :: Gen Word64mod7) id 7 20 21 , testGroup "nextInteger" 22 [ testMiniProperty "valid" $ \a b c d seed -> do 23 let lo' = fromIntegral (a :: Int64) * fromIntegral (b :: Int64) 24 hi' = fromIntegral (c :: Int64) * fromIntegral (d :: Int64) 25 26 lo = min lo' hi' 27 hi = max lo' hi' 28 29 let g = SM.mkSMGen seed 30 (x, _) = SM.nextInteger lo' hi' g 31 32 counterexample (show x) $ lo <= x && x <= hi 33 34 , testMiniProperty "valid small" $ \a b seed -> do 35 let lo' = fromIntegral (a :: Int64) `rem` 10 36 hi' = fromIntegral (b :: Int64) `rem` 10 37 38 lo = min lo' hi' 39 hi = max lo' hi' 40 41 let g = SM.mkSMGen seed 42 (x, _) = SM.nextInteger lo' hi' g 43 44 counterexample (show x) $ lo <= x && x <= hi 45 46 , testMiniProperty "I1 valid" i1valid 47 , testUniformity "I1 uniform" arbitrary (\(I1 w) -> w) 15 48 49 , testMiniProperty "I7 valid" i7valid 50 , testUniformity "I7 uniform" arbitrary (\(I7 w) -> w `mod` 7) 7 51 ] 52 53 , testGroup "SM bitmaskWithRejection" 54 [ testMiniProperty "64" $ \w' seed -> do 55 let w = w' .&. 0xff 56 let w1 = w + 1 57 let g = SM.mkSMGen seed 58 let (x, _) = SM.bitmaskWithRejection64 w1 g 59 counterexample ("64-64 " ++ show x ++ " <= " ++ show w) (x < w1) 60 , testMiniProperty "64'" $ \w' seed -> do 61 let w = w' .&. 0xff 62 let g = SM.mkSMGen seed 63 let (x, _) = SM.bitmaskWithRejection64' w g 64 counterexample ("64-64 " ++ show x ++ " < " ++ show w) (x <= w) 65 , testMiniProperty "32" $ \w' seed -> do 66 let w = w' .&. 0xff 67 let u1 = w' 68 let g = SM.mkSMGen seed 69 let (x, _) = SM.bitmaskWithRejection32 u1 g 70 counterexample ("64-32 " ++ show x ++ " <= " ++ show w) (x < u1) 71 , testMiniProperty "32'" $ \w' seed -> do 72 let w = w' .&. 0xff 73 let u = w 74 let g = SM.mkSMGen seed 75 let (x, _) = SM.bitmaskWithRejection32' u g 76 counterexample ("64-32 " ++ show x ++ " < " ++ show w) (x <= u) 77 ] 78 , testGroup "SM32 bitmaskWithRejection" 79 [ testMiniProperty "64" $ \w' seed -> do 80 let w = w' .&. 0xff 81 let w1 = w + 1 82 let g = SM32.mkSMGen seed 83 let (x, _) = SM32.bitmaskWithRejection64 w1 g 84 counterexample ("64-64 " ++ show x ++ " <= " ++ show w) (x < w1) 85 , testMiniProperty "64'" $ \w' seed -> do 86 let w = w' .&. 0xff 87 let g = SM32.mkSMGen seed 88 let (x, _) = SM32.bitmaskWithRejection64' w g 89 counterexample ("64-64 " ++ show x ++ " < " ++ show w) (x <= w) 90 , testMiniProperty "32" $ \w' seed -> do 91 let w = w' .&. 0xff 92 let u1 = w' 93 let g = SM32.mkSMGen seed 94 let (x, _) = SM32.bitmaskWithRejection32 u1 g 95 counterexample ("64-32 " ++ show x ++ " <= " ++ show w) (x < u1) 96 , testMiniProperty "32'" $ \w' seed -> do 97 let w = w' .&. 0xff 98 let u = w 99 let g = SM32.mkSMGen seed 100 let (x, _) = SM32.bitmaskWithRejection32' u g 101 counterexample ("64-32 " ++ show x ++ " < " ++ show w) (x <= u) 102 ] 103 ] 104 105newtype Word64mod7 = W7 Word64 deriving (Eq, Ord, Show) 106instance Arbitrary Word64mod7 where 107 arbitrary = Gen $ \g -> W7 $ fst $ SM.bitmaskWithRejection64' 6 g 108 109newtype Integer1 = I1 Integer deriving (Eq, Ord, Show) 110instance Arbitrary Integer1 where 111 arbitrary = Gen $ \g -> I1 $ fst $ SM.nextInteger i1min i1max g 112 113i1min :: Integer 114i1min = -7 115 116i1max :: Integer 117i1max = 7 118 119i1valid :: Integer1 -> Bool 120i1valid (I1 i) = i1min <= i && i <= i1max 121 122newtype Integer7 = I7 Integer deriving (Eq, Ord, Show) 123instance Arbitrary Integer7 where 124 arbitrary = Gen $ \g -> I7 $ fst $ SM.nextInteger i7min i7max g 125 126i7min :: Integer 127i7min = negate two64 128 129i7max :: Integer 130i7max = two64 * 6 + 7 * 1234567 131 132i7valid :: Integer7 -> Bool 133i7valid (I7 i) = i7min <= i && i <= i7max 134 135two64 :: Integer 136two64 = 2 ^ (64 :: Int) 137