{-# 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
(Int -> RandomTestResult -> ShowS)
-> (RandomTestResult -> String)
-> ([RandomTestResult] -> ShowS)
-> Show RandomTestResult
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
(RandomTestResult -> RandomTestResult -> Bool)
-> (RandomTestResult -> RandomTestResult -> Bool)
-> Eq RandomTestResult
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 (IOVector Word64 -> RandomTestState)
-> IO (IOVector Word64) -> IO RandomTestState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word64 -> IO (MVector (PrimState IO) Word64)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MVector (PrimState m) a)
M.replicate 256 0
randomTestAppend :: RandomTestState -> L.ByteString -> IO ()
randomTestAppend :: RandomTestState -> ByteString -> IO ()
randomTestAppend (RandomTestState buckets :: IOVector Word64
buckets) = ByteString -> IO ()
loop
where loop :: ByteString -> IO ()
loop bs :: ByteString
bs
| ByteString -> Bool
L.null ByteString
bs = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
let (b1 :: ByteString
b1,b2 :: ByteString
b2) = Int64 -> ByteString -> (ByteString, ByteString)
L.splitAt Int64
monteN ByteString
bs
(Word8 -> IO ()) -> [Word8] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Word64 -> Int -> IO ()
addVec 1 (Int -> IO ()) -> (Word8 -> Int) -> Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> IO ()) -> [Word8] -> IO ()
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 a :: Word64
a i :: Int
i = MVector (PrimState IO) Word64 -> Int -> IO Word64
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
M.read IOVector Word64
MVector (PrimState IO) Word64
buckets Int
i IO Word64 -> (Word64 -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \d :: Word64
d -> MVector (PrimState IO) Word64 -> Int -> Word64 -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
M.write IOVector Word64
MVector (PrimState IO) Word64
buckets Int
i (Word64 -> IO ()) -> Word64 -> IO ()
forall a b. (a -> b) -> a -> b
$! Word64
dWord64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
a
randomTestFinalize :: RandomTestState -> IO RandomTestResult
randomTestFinalize :: RandomTestState -> IO RandomTestResult
randomTestFinalize (RandomTestState buckets :: IOVector Word64
buckets) = ([Word64] -> RandomTestResult
calculate ([Word64] -> RandomTestResult)
-> (Vector Word64 -> [Word64]) -> Vector Word64 -> RandomTestResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word64 -> [Word64]
forall a. Vector a -> [a]
V.toList) (Vector Word64 -> RandomTestResult)
-> IO (Vector Word64) -> IO RandomTestResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` MVector (PrimState IO) Word64 -> IO (Vector Word64)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.freeze IOVector Word64
MVector (PrimState IO) Word64
buckets
monteN :: Int64
monteN :: Int64
monteN = 6
calculate :: [Word64] -> RandomTestResult
calculate :: [Word64] -> RandomTestResult
calculate buckets :: [Word64]
buckets = RandomTestResult :: Word64
-> Double
-> Double
-> Double
-> Double
-> [Double]
-> RandomTestResult
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 = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
datasum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars
, res_compressionPercent :: Double
res_compressionPercent = 100.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (8 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
entropy) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 8.0
, res_probs :: [Double]
res_probs = [Double]
probs
}
where totalChars :: Word64
totalChars = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Word64]
buckets
probs :: [Double]
probs = (Word64 -> Double) -> [Word64] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (\v :: Word64
v -> Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars :: Double) [Word64]
buckets
entropy :: Double
entropy = (Double -> Double -> Double) -> Double -> [Double] -> Double
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Double -> Double -> Double
forall p. (Ord p, Floating p) => p -> p -> p
accEnt 0.0 [Double]
probs
cexp :: Double
cexp = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
totalChars Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 256.0 :: Double
(datasum :: Word64
datasum, chisq :: Double
chisq) = ((Word64, Double) -> Int -> (Word64, Double))
-> (Word64, Double) -> [Int] -> (Word64, Double)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word64, Double) -> Int -> (Word64, Double)
accMeanChi (0, 0.0) [0..255]
accEnt :: p -> p -> p
accEnt ent :: p
ent pr :: p
pr
| p
pr p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> 0.0 = p
ent p -> p -> p
forall a. Num a => a -> a -> a
+ (p
pr p -> p -> p
forall a. Num a => a -> a -> a
* p -> p
forall a. Floating a => a -> a
xlog (1 p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
pr))
| Bool
otherwise = p
ent
xlog :: a -> a
xlog v :: a
v = a -> a -> a
forall a. Floating a => a -> a -> a
logBase 10 a
v a -> a -> a
forall a. Num a => a -> a -> a
* (a -> a
forall a. Floating a => a -> a
log 10 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a. Floating a => a -> a
log 2)
accMeanChi :: (Word64, Double) -> Int -> (Word64, Double)
accMeanChi :: (Word64, Double) -> Int -> (Word64, Double)
accMeanChi (dataSum :: Word64
dataSum, chiSq :: Double
chiSq) i :: Int
i =
let ccount :: Word64
ccount = [Word64]
buckets [Word64] -> Int -> Word64
forall a. [a] -> Int -> a
!! Int
i
a :: Double
a = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
ccount Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cexp
in (Word64
dataSum Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
ccount, Double
chiSq Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
a Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
cexp))