{-# LANGUAGE GADTs #-}
module Crypto.Random.Test
( RandomTestState
, RandomTestResult(..)
, randomTestInitialize
, randomTestAppend
, randomTestFinalize
) where
import Data.Word
import Data.Int (Int64)
import qualified Data.ByteString.Lazy as L
import Control.Applicative
import Data.List (foldl')
import qualified Data.Vector.Mutable as M
import qualified Data.Vector as V
data RandomTestResult = RandomTestResult
{ RandomTestResult -> Word64
res_totalChars :: Word64
, RandomTestResult -> Double
res_entropy :: Double
, RandomTestResult -> Double
res_chi_square :: Double
, RandomTestResult -> Double
res_mean :: Double
, RandomTestResult -> Double
res_compressionPercent :: Double
, RandomTestResult -> [Double]
res_probs :: [Double]
} deriving (Int -> RandomTestResult -> ShowS
[RandomTestResult] -> ShowS
RandomTestResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RandomTestResult] -> ShowS
$cshowList :: [RandomTestResult] -> ShowS
show :: RandomTestResult -> String
$cshow :: RandomTestResult -> String
showsPrec :: Int -> RandomTestResult -> ShowS
$cshowsPrec :: Int -> RandomTestResult -> ShowS
Show,RandomTestResult -> RandomTestResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RandomTestResult -> RandomTestResult -> Bool
$c/= :: RandomTestResult -> RandomTestResult -> Bool
== :: RandomTestResult -> RandomTestResult -> Bool
$c== :: RandomTestResult -> RandomTestResult -> Bool
Eq)
newtype RandomTestState = RandomTestState (M.IOVector Word64)
randomTestInitialize :: IO RandomTestState
randomTestInitialize :: IO RandomTestState
randomTestInitialize = IOVector Word64 -> RandomTestState
RandomTestState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate Int
256 Word64
0
randomTestAppend :: RandomTestState -> L.ByteString -> IO ()
randomTestAppend :: RandomTestState -> ByteString -> IO ()
randomTestAppend (RandomTestState IOVector Word64
buckets) = ByteString -> IO ()
loop
where loop :: ByteString -> IO ()
loop ByteString
bs
| ByteString -> Bool
L.null ByteString
bs = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
let (ByteString
b1,ByteString
b2) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
monteN ByteString
bs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Word64 -> Int -> IO ()
addVec Word64
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
L.unpack ByteString
b1
ByteString -> IO ()
loop ByteString
b2
addVec :: Word64 -> Int -> IO ()
addVec :: Word64 -> Int -> IO ()
addVec Word64
a Int
i = forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
M.read IOVector Word64
buckets Int
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word64
d -> forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
M.write IOVector Word64
buckets Int
i forall a b. (a -> b) -> a -> b
$! Word64
dforall a. Num a => a -> a -> a
+Word64
a
randomTestFinalize :: RandomTestState -> IO RandomTestResult
randomTestFinalize :: RandomTestState -> IO RandomTestResult
randomTestFinalize (RandomTestState IOVector Word64
buckets) = ([Word64] -> RandomTestResult
calculate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze IOVector Word64
buckets
monteN :: Int64
monteN :: Int64
monteN = Int64
6
calculate :: [Word64] -> RandomTestResult
calculate :: [Word64] -> RandomTestResult
calculate [Word64]
buckets = RandomTestResult
{ res_totalChars :: Word64
res_totalChars = Word64
totalChars
, res_entropy :: Double
res_entropy = Double
entropy
, res_chi_square :: Double
res_chi_square = Double
chisq
, res_mean :: Double
res_mean = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
datasum forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars
, res_compressionPercent :: Double
res_compressionPercent = Double
100.0 forall a. Num a => a -> a -> a
* (Double
8 forall a. Num a => a -> a -> a
- Double
entropy) forall a. Fractional a => a -> a -> a
/ Double
8.0
, res_probs :: [Double]
res_probs = [Double]
probs
}
where totalChars :: Word64
totalChars = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Word64]
buckets
probs :: [Double]
probs = forall a b. (a -> b) -> [a] -> [b]
map (\Word64
v -> forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars :: Double) [Word64]
buckets
entropy :: Double
entropy = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. (Ord a, Floating a) => a -> a -> a
accEnt Double
0.0 [Double]
probs
cexp :: Double
cexp = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars forall a. Fractional a => a -> a -> a
/ Double
256.0 :: Double
(Word64
datasum, Double
chisq) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word64, Double) -> Int -> (Word64, Double)
accMeanChi (Word64
0, Double
0.0) [Int
0..Int
255]
accEnt :: a -> a -> a
accEnt a
ent a
pr
| a
pr forall a. Ord a => a -> a -> Bool
> a
0.0 = a
ent forall a. Num a => a -> a -> a
+ (a
pr forall a. Num a => a -> a -> a
* forall {a}. Floating a => a -> a
xlog (a
1 forall a. Fractional a => a -> a -> a
/ a
pr))
| Bool
otherwise = a
ent
xlog :: a -> a
xlog a
v = forall a. Floating a => a -> a -> a
logBase a
10 a
v forall a. Num a => a -> a -> a
* (forall {a}. Floating a => a -> a
log a
10 forall a. Fractional a => a -> a -> a
/ forall {a}. Floating a => a -> a
log a
2)
accMeanChi :: (Word64, Double) -> Int -> (Word64, Double)
accMeanChi :: (Word64, Double) -> Int -> (Word64, Double)
accMeanChi (Word64
dataSum, Double
chiSq) Int
i =
let ccount :: Word64
ccount = [Word64]
buckets forall a. [a] -> Int -> a
!! Int
i
a :: Double
a = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ccount forall a. Num a => a -> a -> a
- Double
cexp
in (Word64
dataSum forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i forall a. Num a => a -> a -> a
* Word64
ccount, Double
chiSq forall a. Num a => a -> a -> a
+ (Double
a forall a. Num a => a -> a -> a
* Double
a forall a. Fractional a => a -> a -> a
/ Double
cexp))