freq 0.0.0 → 0.1.0.0
raw patch · 8 files changed
+829/−18 lines, 8 filesdep +basedep +bytestringdep +containersnew-component:exe:freq-train
Dependencies added: base, bytestring, containers, freq, gauge, hedgehog, primitive
Files
- LICENSE +2/−2
- README.md +11/−1
- app/Main.hs +58/−0
- bench/Main.hs +66/−0
- freq.cabal +68/−15
- src/Freq.hs +213/−0
- src/Freq/Internal.hs +338/−0
- test/Main.hs +73/−0
LICENSE view
@@ -1,4 +1,4 @@-Copyright chessai (c) 2018+Copyright (c) 2018, chessai All rights reserved. @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Chris Done nor the names of other+ * Neither the name of chessai nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission.
README.md view
@@ -1,3 +1,13 @@ # freq -Currently being prepared for release at https://github.com/chessai/freq, reserving the namespace here.+## About+This is a simple cryptanalytic frequency analysis tool that uses [english character digrams](https://en.wikipedia.org/wiki/Bigram) as a probabilistic model for scoring ByteStrings according to their randomness (0..1, 0 being the most random, 1 being the least random).++## Uses+I currently use this to validate domain names, and so the training data available consists of about 6.5 Megabytes of Public Domain 19th and 20th century English novels. You can feed any training data you wish to 'freq' to achieve different results.++## Improvements+To improve further on the accuracy of this approach, I will experiment with a generalised dynamic n-gram approach, which will sacrifice slightly in performance for a potentially large gain in accuracy. ++## Further+See my implementation of the [Linear Hadamard Spectral Test](https://github.com/chessai/lhst) for a different approach to a similar problem with much higher variance in the potentially random data, where a trained approach might be less accurate.
+ app/Main.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Freq+import Control.Monad (forever)+import qualified Data.ByteString.Char8 as BC (getLine)++trainTexts :: [FilePath]+trainTexts+ = fmap (\x -> "txtdocs/" ++ x ++ ".txt")+ [ "2000010"+ , "2city10"+ , "80day10"+ , "alcott-little-261"+ , "byron-don-315"+ , "carol10"+ , "center_earth"+ , "defoe-robinson-103"+ , "dracula"+ , "freck10"+ , "invisman"+ , "kipling-jungle-148"+ , "lesms10"+ , "london-call-203"+ , "london-sea-206"+ , "longfellow-paul-210"+ , "madambov"+ , "monroe-d"+ , "moon10"+ , "ozland10"+ , "plgrm10"+ , "sawy210"+ , "speckldb"+ , "swift-modest-171"+ , "time_machine"+ , "war_peace"+ , "white_fang"+ , "zenda10"+ ]++passes :: Double -> String+passes x+ | x < 0.05 = "Too random!"+ | otherwise = "Looks good to me!"++main :: IO ()+main = do+ !freak <- trainWithMany trainTexts+ let !freakTable = tabulate freak + putStrLn "Done loading frequencies"+ forever $ do+ putStrLn "Enter text:"+ !bs <- BC.getLine + let !score = measure freakTable bs + putStrLn $ "Score: " ++ show score ++ "\n"+ ++ passes score
+ bench/Main.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE BangPatterns #-}++module Main (main) where++import Gauge.Main+import Data.ByteString (ByteString)+import Data.Word (Word8)+import Data.Char (ord)+import Freq+import qualified Data.ByteString as B+import qualified Data.List as L++trainTexts :: [FilePath]+trainTexts+ = fmap (\x -> "txtdocs/" ++ x ++ ".txt")+ [ "2000010"+ , "2city10"+ , "80day10"+ , "alcott-little-261"+ , "byron-don-315"+ , "carol10"+ , "center_earth"+ , "defoe-robinson-103"+ , "dracula"+ , "freck10"+ , "invisman"+ , "kipling-jungle-148"+ , "lesms10"+ , "london-call-203"+ , "london-sea-206"+ , "longfellow-paul-210"+ , "madambov"+ , "monroe-d"+ , "moon10"+ , "ozland10"+ , "plgrm10"+ , "sawy210"+ , "speckldb"+ , "swift-modest-171"+ , "time_machine"+ , "top-1m"+ , "war_peace"+ , "white_fang"+ , "zenda10"+ ]++c2w :: Char -> Word8+c2w = fromIntegral . ord+{-# INLINE c2w #-}++main :: IO ()+main = do+ !freak <- trainWithMany trainTexts+ let !freakTable = tabulate freak+ Prelude.putStrLn "done loading frequencies"+ let !bs = B.pack $ fmap c2w $ (L.take 50000 (L.cycle ['a'..'z']))+ Prelude.putStrLn "done making test bytestrings"+ Prelude.putStrLn "now gauging....!!!"++ defaultMain+ [ + bgroup "FREAKY MAP VS. FREAKY TABLE: "+ [ bench "FREAKY MAP" $ whnf (measure freak) bs+ , bench "FREAKY TABLE" $ whnf (measure freakTable) bs+ ]+ ]
freq.cabal view
@@ -1,20 +1,73 @@-name: freq-version: 0.0.0-synopsis: TBA-description: Currently being prepared for release, reserving the namespace here.-license: BSD3-license-file: LICENSE-author: chessai-maintainer: chessai1996@gmail.com-copyright: 2018 chessai-category: Data-build-type: Simple-extra-source-files: README.md-cabal-version: >=1.10+--------------------------------------------------------------------- +name: freq+version: 0.1.0.0+build-type: Simple+cabal-version: >= 1.10+category: Data+author: Daniel Cartwright+maintainer: dcartwright@layer3com.com+license: MIT+license-file: LICENSE+homepage: https://github.com/chessai/freq+bug-reports: https://github.com/chessai/freq/issues+synopsis:+ Are you ready to get freaky?+description:+ This library provides a way to train a model that predicts+ the "randomness" of an input ByteString.+extra-source-files: README.md+tested-with: GHC == 8.2.1, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.4.2++---------------------------------------------------------------------+ source-repository head- type: git- location: https://github.com/chessai/freq+ type: git+ branch: master+ location: https://github.com/chessai/freq.git +---------------------------------------------------------------------+ library+ hs-source-dirs: src + build-depends: base >= 4.9 && < 5.0+ , bytestring + , containers + , primitive >= 0.6.1+ exposed-modules: Freq+ Freq.Internal + default-language: Haskell2010++test-suite test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs:+ test+ build-depends:+ base >=4.7 && <5+ , bytestring + , containers+ , freq+ , hedgehog default-language: Haskell2010++benchmark bench+ type: exitcode-stdio-1.0+ build-depends:+ base+ , bytestring+ , containers+ , freq+ , gauge+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++executable freq-train+ hs-source-dirs: app+ build-depends: base, freq, bytestring, containers+ main-is: Main.hs+ default-language: Haskell2010++---------------------------------------------------------------------+
+ src/Freq.hs view
@@ -0,0 +1,213 @@+{-# OPTIONS_GHC -O2 -Wall #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++{-| This library provides a way to train a model+ that predicts the "randomness" of an input @'ByteString'@,+ and two datatypes to facilitate this:++ @'FreqTrain'@ is a datatype that can be constructed via+ training functions that take @'ByteString'@s as input, and+ can be used with the @'measure'@ function to gather an+ estimate of the aforementioned probability of "randomness".++ @'Freq'@ is a datatype that is constructed by calling the @'tabulate'@+ function on a @'FreqTrain'@. @'Freq'@s are meant solely for using (accessing+ the "randomness" values) the trained model in practise, by making+ significant increases to speed in exchange for less extensibility;+ you can neither make a change to a @'Freq'@ or convert it back to+ a @'FreqTrain'@. In practise this however proves to not be a problem,+ because training usually only happens once.++ Laws:+ + @ 'measure' (f :: 'FreqTrain') b ≡ 'measure' ('tabulate' f) b @++ + Below is a simple illustration of how to use this library.+ We are going to write a small command-line application that+ trains on some data, and scores @'ByteString'@s according to how+ random they are. We will say that a @'ByteString'@ is 'random'+ if it scores less than 0.05 (on a scale of 0 to 1), and not random+ otherwise.+ + First, some imports:+ + @ + import Freq+ import Control.Monad (forever)+ + import qualified Data.ByteString.Char8 as BC+ @+ + Next, a list of @'FilePath'@s containing training data.+ The training data here is the same as is provided in+ the sample executable of this library. It consists solely+ of books in the Public Domain.+ + @ + trainTexts :: [FilePath]+ trainText+ = fmap (\x -> "txtdocs/" ++ x ".txt")+ -- ^ this line just tells us that all+ -- of the training data is in the 'txtdocs'+ -- directory, and has a '.txt' file extension.+ [ "2000010"+ , "2city10"+ , "80day10"+ , "alcott-little-261"+ , "byron-don-315"+ , "carol10"+ , "center_earth"+ , "defoe-robinson-103"+ , "dracula"+ , "freck10"+ , "invisman"+ , "kipling-jungle-148"+ , "lesms10"+ , "london-call-203"+ , "london-sea-206"+ , "longfellow-paul-210"+ , "madambov"+ , "monroe-d"+ , "moon10"+ , "ozland10"+ , "plgrm10"+ , "sawy210"+ , "speckldb"+ , "swift-modest-171"+ , "time_machine"+ , "war_peace"+ , "white_fang"+ , "zenda10"+ ]+ @++ We are going to use a function provided by this library+ called @'trainWithMany'@. Its type signature is:++ @+ trainWithMany+ :: Foldable t+ => t FilePath -- ^ FilePaths containing training data+ -> IO FreqTrain -- ^ Frequency table generated as a result of training, inside of 'IO'+ @+ + In other words, @'trainWithMany'@ takes a bunch of files,+ trains a model with all of the training data contained therein,+ and returns a @'FreqTrain'@ inside of @'IO'@.++ And now, we get freaky:++ @++ -- | "passes" returns a message letting the user know whether+ -- or not their input 'ByteString' was most likely random.+ -- Recall that our threshold is 0.05 on a scale of 0 to 1.+ passes :: Double -> String+ passes x+ | x < 0.05 = "Too random!"+ | otherwise = "Looks good to me!"++ main :: IO ()+ main = do+ !freak <- trainWithMany trainTexts+ -- ^ create the trained model+ + let !freakTable = tabulate freak+ -- ^ optimise the trained model for+ -- read access+ + putStrLn "Done loading frequencies."+ -- ^ let the user known that our model+ -- is done training and has finished+ -- optimising into a 'Freq'+ + forever $ do+ -- ^ make the following loop forever + + putStrLn "Enter text:"+ -- ^ ask the user for some text+ + !bs <- BC.getLine+ -- ^ bs is the input 'ByteString' to score+ + let !score = measure freakTable bs+ -- ^ score of the 'ByteString'!+ + putStrLn $ "Score: " ++ show score ++ "\n"+ ++ passes score+ -- ^ print out what the score of the 'ByteString' was,+ -- along with its 'passing status'.+ @++ This results in the following interactions, split up for readability:++ >>> Done loading frequencies.+ >>> Enter text:+ >>> freq+ >>> Score: 0.10314131395591991+ >>> Looks good to me!+ + >>> Enter text:+ >>> kjdslfkajdslkfjsd+ >>> Score: 6.693203041828383e-3+ >>> Too random!+ + >>> Enter text:+ >>> William+ >>> Score: 7.086442245879888e-2+ >>> Looks good to me!++ >>> Enter text:+ >>> 8op3u92jf+ >>> Score: 6.687182330334067e-3+ >>> Too random!+ + As we can see, it rejects the keysmashed text as being too random,+ while the human-readable text is A-OK. I actually made the threshold+ of 0.05 too high - it should be somewhere between 0.01 and 0.03, but+ even then the outcomes would have still been the same. The digram-based+ approach that 'freq' uses may seem ridiculously naive, but still+ maintains a high degree of accuracy.++ As an example of a real-world use case, I wrote 'freq' to use at my+ workplace (I work at a Network Security company) as a way to score+ TLDs (top-level domains) according to how random they are. Malicious+ users spin up fake domains frequently using strings of random characters+ as the TLD. This can also be used to score Windows executables, since+ those follow the same pattern of malicious naming.++ An obvious weakness of this library is that it suffers from what can+ be referred to as the "xkcd problem". It can score things such as 'xkcd'+ poorly, even though they are perfectly legitimate TLDs. The fix I use is+ to use something like the alexa top 1 million list of TLDs, along with a+ HashMap(s) for whitelisting/blacklisting.++ As a wise man once told me - "And then I freaked it."+-}++module Freq+ ( -- * Frequency table builder (trainer) type+ FreqTrain+ + -- * Construction+ , empty + , singleton++ -- * Training+ , train + , trainWith+ , trainWithMany++ -- * Using a trained model+ , tabulate+ , Freq+ , measure+ , prob+ + -- * Pretty Printing+ , prettyFreqTrain+ ) where++import Data.ByteString (ByteString)+import Freq.Internal
+ src/Freq/Internal.hs view
@@ -0,0 +1,338 @@+--------------------------------------------------------------------------------++{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language NoImplicitPrelude #-}+{-# language ScopedTypeVariables #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++{-# OPTIONS_GHC -O2 -Wall #-}++--------------------------------------------------------------------------------++{-| This is the internal module to 'Freq'.+ The primary differences are that this+ module exports the typeclass 'Freaky',+ as well as the data constructors of+ 'FreqTrain' and 'Freq'.+-}++module Freq.Internal+ ( -- * Frequency table type+ FreqTrain(..)++ -- * Construction+ , empty + , singleton+ + , tabulate++ -- * Training+ , train + , trainWith+ , trainWithMany++ -- * Using a trained model+ , Freq(..)+ , measure+ , Freaky(prob)++ -- * Pretty Printing+ , prettyFreqTrain+ ) where++--------------------------------------------------------------------------------++import Control.Applicative (Applicative(..))+import Control.Monad ((>>))+import Control.Monad.ST (ST,runST)+import Data.ByteString.Internal (ByteString(..), w2c)+import Data.Foldable+import Data.Map.Strict.Internal (Map)+import Data.Maybe (fromMaybe)+import Data.Monoid+import Data.Primitive.ByteArray (ByteArray)+import Data.Semigroup+import Data.Set (Set)+import Data.Word (Word8)+import GHC.Base hiding (empty)+import Prelude (FilePath, (+), (*), (-), (/), show, mod)++import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Unsafe as BU+import qualified Data.Map.Strict as DMS+import qualified Data.Primitive.ByteArray as PM+import qualified Data.Primitive.Types as PM+import qualified Data.Set as S+import qualified GHC.OldList as L+import qualified Numeric as Numeric+import qualified Prelude as P++--------------------------------------------------------------------------------++-- | @'Freaky'@ is a typeclass that wraps the @'prob'@ function,+-- which allows for an extensible definition of @'measure'@.+--+-- It is used internally.+class Freaky a where+ -- | Given a Frequency table and characters 'c1' and 'c2',+ -- what is the probability that 'c1' follows 'c2'?+ prob :: a -> Word8 -> Word8 -> Double++-- | Given a Frequency table and a @'ByteString'@, @'measure'@+-- returns the probability that the @'ByteString'@ is not+-- randomised. The accuracy of @'measure'@ is is heavily affected+-- by your training data.+measure :: Freaky a => a -> BC.ByteString -> Double+measure _ (PS _ _ 0) = 0+measure _ (PS _ _ 1) = 0+measure f !b = (go 0 0) / (P.fromIntegral l)+ where+ l :: Int+ l = BC.length b - 1++ go :: Int -> Double -> Double+ go !p !acc+ | p == l = acc+ | otherwise =+ let k = BU.unsafeIndex b p+ r = BU.unsafeIndex b (p + 1)+ in go (p + 1) (prob f k r + acc)+{-# INLINE measure #-}++--------------------------------------------------------------------------------++-- | A @'FreqTrain'@ is a digram-based frequency table.+-- +-- One can construct a @'FreqTrain'@ with @'train'@,+-- @'trainWith'@, or @'trainWithMany'@.+--+-- One can use a trained @'FreqTrain'@ with @'prob'@+-- and @'measure'@.+-- +-- @'mappend' == '<>'@ will add the values of each+-- of the matching keys.+--+-- It is highly recommended to convert a @'FreqTrain'@+-- to a @'Freq'@ with @'tabulate'@ before using the trained model,+-- because @'Freq'@s have /O(1)/ reads as well as significantly+-- faster constant-time operations, however keep in mind+-- that @'Freq'@s cannot be neither modified nor converted+-- back to a @'FreqTrain'@.+--+newtype FreqTrain = FreqTrain+ { _getFreqTrain :: Map Word8 (Map Word8 Double) }++instance Freaky FreqTrain where+ prob (FreqTrain f) w1 w2 =+ case DMS.lookup w1 f of+ Nothing -> 0+ Just g -> case DMS.lookup w2 g of+ Nothing -> 0+ Just weight -> ratio weight g+ {-# INLINE prob #-}++instance Semigroup FreqTrain where+ {-# INLINE (<>) #-} + (FreqTrain a) <> (FreqTrain b) = FreqTrain $ union a b++instance Monoid FreqTrain where+ {-# INLINE mempty #-} + mempty = empty+ {-# INLINE mappend #-} + (FreqTrain a) `mappend` (FreqTrain b) = FreqTrain $ union a b++--------------------------------------------------------------------------------++-- | /O(1)/. The empty frequency table.+empty :: FreqTrain+empty = FreqTrain DMS.empty+{-# INLINE empty #-}++-- | /O(1)/. A Frequency table with a single entry.+singleton :: Word8 -- ^ Outer key+ -> Word8 -- ^ Inner key+ -> Double -- ^ Weight+ -> FreqTrain -- ^ The singleton frequency table+singleton k ka w = FreqTrain $ DMS.singleton k (DMS.singleton ka w)+{-# INLINE singleton #-}++-- | Optimise a 'FreqTrain' for /O(1)/ read access.+tabulate :: FreqTrain -> Freq+tabulate = tabulateInternal+{-# INLINE tabulate #-}+ +--------------------------------------------------------------------------------++-- | Given a @'ByteString'@ consisting of training data,+-- build a Frequency table.+train :: BC.ByteString+ -> FreqTrain+train !b = tally b+{-# INLINE train #-}++-- | Given a @'FilePath'@ containing training data, build a+-- Frequency table inside of the @'IO'@ monad.+trainWith :: FilePath -- ^ @'FilePath'@ containing training data+ -> IO FreqTrain -- ^ Frequency table generated as a result of training, inside of @'IO'@.+trainWith !path = BC.readFile path >>= (pure . tally)+{-# INLINE trainWith #-}++-- | Given a list of @'FilePath'@ containing training data,+-- build a Frequency table inside of the @'IO'@ monad.+trainWithMany :: Foldable t+ => t FilePath -- ^ @'FilePath'@s containing training data+ -> IO FreqTrain -- ^ Frequency table generated as a result of training, inside of @'IO'@.+trainWithMany !paths = foldMap trainWith paths+{-# INLINE trainWithMany #-}++--------------------------------------------------------------------------------++-- | Pretty-print a @'FreqTrain'@.+--+prettyFreqTrain :: FreqTrain -> IO ()+prettyFreqTrain (FreqTrain m)+ = DMS.foldMapWithKey+ (\c1 m' ->+ P.putStrLn (if c1 == 10 then "\\n" else [w2c c1])+ >> DMS.foldMapWithKey+ (\c2 prb -> P.putStrLn (" " ++ [w2c c2] ++ " " ++ P.show (P.round prb :: Int))) m') m++--------------------------------------------------------------------------------++-- | A variant of @'FreqTrain'@ that holds identical information but+-- is optimised for reads. There are no operations that imbue+-- a @'Freq'@ with additional information.+--+-- Reading from a @'Freq'@ is orders of magnitude faster+-- than reading from a @'FreqTrain'@. It is /highly/+-- recommended that you use your trained model by first+-- converting a @'FreqTrain'@ to a @'Freq'@ with @'tabulate'@.+data Freq = Freq+ { _Dim :: !Int+ -- ^ Width and height of square 2d array+ , _2d :: !ByteArray+ -- ^ Square two-dimensional array of Double, maps first char and second char to probability+ , _Flat :: !ByteArray+ -- ^ Array of Word8, length 256, acts as map from Word8 to table row/column index+ }++instance Freaky Freq where+ {-# INLINE prob #-} + prob (Freq sz square ixs) chrFst chrSnd =+ let !ixFst = word8ToInt (PM.indexByteArray ixs (word8ToInt chrFst))+ !ixSnd = word8ToInt (PM.indexByteArray ixs (word8ToInt chrSnd))+ in PM.indexByteArray square (sz * ixFst + ixSnd)++-- This exists for debugging purposes+instance P.Show Freq where+ show (Freq i arr ixs) =+ P.show i ++ "x" ++ show i+ ++ "\n"+ ++ "\n2D Array: \n"+ ++ go 0+ ++ "\n256 Array: \n"+ ++ ho 0+ where+ ho :: Int -> String+ ho !ix = if ix < PM.sizeofByteArray ixs+ then+ let col = ix `mod` 16+ extra = if col == 15 then "\n" else ""+ in show (PM.indexByteArray ixs ix :: Word8) ++ " " ++ extra ++ ho (ix + 1)+ else ""+ + go :: Int -> String+ go !ix = if ix < elemSz+ then+ let col = ix `mod` i+ extra = if col == (i - 1) then "\n" else "" + in showFloat (PM.indexByteArray arr ix :: Double) ++ " " ++ extra ++ go (ix + 1) + else ""+ where+ !elemSz = P.div (PM.sizeofByteArray arr) (PM.sizeOf (undefined :: Double))+ showFloat :: P.RealFloat a => a -> String+ showFloat !x = Numeric.showFFloat (Just 2) x ""++--------------------------------------------------------------------+-- Internal Section --+--------------------------------------------------------------------++word8ToInt :: Word8 -> Int+word8ToInt !w = P.fromIntegral w+{-# INLINE word8ToInt #-}++intToWord8 :: Int -> Word8+intToWord8 !i = P.fromIntegral i+{-# INLINE intToWord8 #-}++-- | Optimise a 'FreqTrain' for /O(1)/ read access.+--+tabulateInternal :: FreqTrain -> Freq+tabulateInternal (FreqTrain m) = runST comp where+ comp :: forall s. ST s Freq+ comp = do+ let allChars :: Set Word8+ !allChars = S.union (DMS.keysSet m) (foldMap DMS.keysSet m)+ m' :: Map Word8 (Double, Map Word8 Double)+ !m' = fmap (\x -> (sum x, x)) m+ !sz = min (S.size allChars + 1) 256+ !szSq = sz * sz+ ixedChars :: [(Word8,Word8)]+ !ixedChars = L.zip (P.enumFrom (0 :: Word8)) (S.toList allChars)+ ixs <- PM.newByteArray 256+ square <- PM.newByteArray (szSq * PM.sizeOf (undefined :: Double))+ let fillSquare :: Int -> ST s ()+ fillSquare !i = if i < szSq+ then do+ PM.writeByteArray square i (0 :: Double)+ fillSquare (i + 1)+ else pure ()+ fillSquare 0+ PM.fillByteArray ixs 0 256 (intToWord8 (sz - 1))+ forM_ ixedChars $ \(ixFst,w8Fst) -> do+ PM.writeByteArray ixs (word8ToInt w8Fst) ixFst --w8Fst+ forM_ ixedChars $ \(ixSnd,w8Snd) -> do+ let r = fromMaybe 0 $ do+ (total, m'') <- DMS.lookup w8Fst m'+ v <- DMS.lookup w8Snd m''+ pure (v / total)+ PM.writeByteArray square (sz * (word8ToInt ixFst) + (word8ToInt ixSnd)) r+ frozenIxs <- PM.unsafeFreezeByteArray ixs+ frozenSquare <- PM.unsafeFreezeByteArray square+ pure (Freq sz frozenSquare frozenIxs)++-- | Build a frequency table from a ByteString.+tally :: BC.ByteString -- ^ ByteString with which the FreqTrain will be built+ -> FreqTrain -- ^ Resulting FreqTrain+tally (PS _ _ 0) = empty+tally !b = go 0 mempty+ where+ l :: Int+ l = BC.length b - 1++ go :: Int -> FreqTrain -> FreqTrain+ go !p !fr+ | p == l = fr+ | otherwise =+ let k = BU.unsafeIndex b p+ r = BU.unsafeIndex b (p + 1)+ in go (p + 1) (mappend (singleton k r 1) fr)++ratio :: Double -> Map Word8 Double -> Double+ratio !weight g = weight / (sum g)+{-# INLINE ratio #-}++-- A convenience type synonym for internal use.+-- Please /do not/ ask me to rename this to "Tally".+-- https://github.com/andrewthad did this.+-- He is no longer permitted to leave the cave.+--+-- Tal is named after Mikhail Tal.+type Tal = Map Word8 (Map Word8 Double)++-- union two 'Tal', summing the weights belonging to the same keys.+union :: Tal -> Tal -> Tal+union a b = DMS.unionWith (DMS.unionWith (+)) a b+{-# INLINE union #-}
+ test/Main.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Control.Monad (forever)+import Data.ByteString (ByteString)+import Data.Char (ord)+import Data.Word (Word8)+import Freq+import Hedgehog+import qualified Data.ByteString as B+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import qualified Data.List as List++main :: IO Bool+main = do+ !freak <- trainWithMany trainTexts+ let !freakTable = tabulate freak+ Prelude.putStrLn "done loading frequencies"+ Prelude.putStrLn "now testing with Hedgehog"+ checkParallel $ Group "Freak Equality"+ [ ("Freak Equality", prop_Equal freak freakTable)+ ]++trainTexts :: [FilePath]+trainTexts+ = fmap (\x -> "txtdocs/" ++ x ++ ".txt")+ [ "2000010"+ , "2city10"+ , "80day10"+ , "alcott-little-261"+ , "byron-don-315"+ , "carol10"+ , "center_earth"+ , "defoe-robinson-103"+ , "dracula"+ , "freck10"+ , "invisman"+ , "kipling-jungle-148"+ , "lesms10"+ , "london-call-203"+ , "london-sea-206"+ , "longfellow-paul-210"+ , "madambov"+ , "monroe-d"+ , "moon10"+ , "ozland10"+ , "plgrm10"+ , "sawy210"+ , "speckldb"+ , "swift-modest-171"+ , "time_machine"+ , "top-1m" + , "war_peace"+ , "white_fang"+ , "zenda10"+ ]++sizedByteString :: Range.Size -> Gen ByteString+sizedByteString (Range.Size n) = do+ m <- Gen.enum 0 n+ fmap B.pack $ Gen.list (Range.constant 0 m) (randWord8)+ where+ randWord8 :: Gen Word8+ randWord8 = Gen.word8 Range.constantBounded++prop_Equal :: FreqTrain -> Freq -> Property+prop_Equal f ft =+ property $ do+ b <- forAll $ Gen.sized sizedByteString + measure f b === measure ft b