diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright © 2018, chessai +Copyright © 2019, chessai All rights reserved. diff --git a/app/Main.hs b/app/Main.hs deleted file mode 100644 --- a/app/Main.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-# 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 diff --git a/freq.cabal b/freq.cabal --- a/freq.cabal +++ b/freq.cabal @@ -1,23 +1,31 @@ ---------------------------------------------------------------------- - -name: freq -version: 0.1.0.4 -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 +cabal-version: 2.2 +name: + freq +version: + 0.1.1 +author: + chessai +maintainer: + chessai +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 +category: + Text,Data +extra-source-files: + README.md +tested-with: + GHC == 8.2.1, GHC == 8.2.2, GHC == 8.4.1, GHC == 8.4.2 --------------------------------------------------------------------- @@ -29,45 +37,60 @@ --------------------------------------------------------------------- library - hs-source-dirs: src - build-depends: base >= 4.9 && < 5.0 - , bytestring - , containers - , deepseq - , primitive >= 0.6.1 - exposed-modules: Freq - Freq.Internal - default-language: Haskell2010 + exposed-modules: + Freq + Freq.Internal + build-depends: + , base >= 4.9 && < 4.13 + , binary >= 0.8 && < 0.11 + , bytestring >= 0.10 && < 0.11 + , containers >= 0.5 && < 0.7 + , deepseq >= 1.4 && < 1.5 + , primitive >= 0.6.4 && < 0.7 + hs-source-dirs: + src + default-language: + Haskell2010 + ghc-options: + -Wall + -O2 test-suite test - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: - test + type: + exitcode-stdio-1.0 + main-is: + Main.hs build-depends: - base >=4.7 && <5 - , bytestring + , base + , bytestring , containers , freq - , hedgehog - default-language: Haskell2010 + , hedgehog + hs-source-dirs: + test + default-language: + Haskell2010 benchmark bench - type: exitcode-stdio-1.0 + type: + exitcode-stdio-1.0 + main-is: + Main.hs build-depends: base , bytestring , containers , freq , gauge - default-language: Haskell2010 - hs-source-dirs: bench - main-is: Main.hs + hs-source-dirs: + bench + default-language: + Haskell2010 -executable freq-train - hs-source-dirs: app - build-depends: base, freq, bytestring, containers - main-is: Main.hs - default-language: Haskell2010 +--executable freq-train +-- hs-source-dirs: app +-- build-depends: base, freq, bytestring, containers +-- main-is: Main.hs +-- default-language: Haskell2010 --------------------------------------------------------------------- diff --git a/src/Freq.hs b/src/Freq.hs --- a/src/Freq.hs +++ b/src/Freq.hs @@ -47,11 +47,14 @@ -- @ -- trainTexts :: [FilePath] -- trainText --- = fmap (\x -> "txtdocs/" ++ x ".txt") +-- = 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. +-- +-- -- | These are the text files from which we wish to train. +-- -- v -- [ "2000010" -- , "2city10" -- , "80day10" @@ -113,6 +116,10 @@ -- !freak <- trainWithMany trainTexts -- -- ^ -- -- | create the trained model +-- -- | Note that we do this strictly, +-- -- | so that the model is ready to +-- -- | go when we intuitively expect it +-- -- | to be. -- -- let !freakTable = tabulate freak -- -- ^ diff --git a/src/Freq/Internal.hs b/src/Freq/Internal.hs --- a/src/Freq/Internal.hs +++ b/src/Freq/Internal.hs @@ -10,8 +10,6 @@ {-# language UnboxedTuples #-} {-# language TypeFamilies #-} -{-# OPTIONS_GHC -O2 -Wall #-} - -------------------------------------------------------------------------------- {-| This is the internal module to 'Freq'. @@ -54,6 +52,7 @@ import Control.DeepSeq (NFData) import Control.Monad (Monad((>>=)), (>>), forM_) import Control.Monad.ST (ST,runST) +import Data.Binary (Binary(..)) import Data.Bool (otherwise) import Data.ByteString.Internal (ByteString(..), w2c) import Data.Data (Data) @@ -66,13 +65,13 @@ import Data.Maybe (Maybe(Just, Nothing), fromMaybe) import Data.Monoid (Monoid(mempty, mappend)) import Data.Ord (Ord(min, (<))) -import Data.Primitive.ByteArray (ByteArray) +import Data.Primitive.ByteArray (ByteArray,foldrByteArray) import Data.Semigroup (Semigroup((<>))) import Data.Set (Set) import Data.String (String) import Data.Word (Word8) -import GHC.Base (Double, Int(I#)) --hiding (empty) +import GHC.Base (Double, Int(I#), build) import GHC.Err (undefined) import GHC.IO (FilePath, IO) import GHC.Num ((+), (*), (-)) @@ -193,7 +192,7 @@ -------------------------------------------------------------------------------- --- | Given a @'ByteString'@ consisting of training data, +-- | Given a @'BC.ByteString'@ consisting of training data, -- build a Frequency table. train :: BC.ByteString -> FreqTrain @@ -204,7 +203,7 @@ -- 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) +trainWith path = BC.readFile path >>= (pure . tally) {-# INLINE trainWith #-} -- | Given a list of @'FilePath'@ containing training data, @@ -212,7 +211,7 @@ 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 +trainWithMany paths = foldMap trainWith paths {-# INLINE trainWithMany #-} -------------------------------------------------------------------------------- @@ -245,7 +244,24 @@ , _Flat :: !ByteArray -- ^ Array of Word8, length 256, acts as map from Word8 to table row/column index } + deriving (Eq) +toList :: PM.Prim a => ByteArray -> [a] +toList xs = build (\c n -> foldrByteArray c n xs) +{-# INLINE toList #-} + +toDoubles :: ByteArray -> [Double] +toDoubles = toList + +toWord8s :: ByteArray -> [Word8] +toWord8s = toList + +instance Binary Freq where + put (Freq dim ds ws) = put (dim,toDoubles ds,toWord8s ws) + get = do + (dim :: Int,asDoubles :: [Double],asWord8s :: [Word8]) <- get + pure (Freq dim (PM.byteArrayFromList asDoubles) (PM.byteArrayFromList asWord8s)) + instance Freaky Freq where {-# INLINE prob #-} prob (Freq sz square ixs) chrFst chrSnd = @@ -253,7 +269,7 @@ !ixSnd = word8ToInt (PM.indexByteArray ixs (word8ToInt chrSnd)) in PM.indexByteArray square (sz * ixFst + ixSnd) --- This exists for debugging purposes +-- | This exists for debugging purposes instance P.Show Freq where show (Freq i arr ixs) = P.show i ++ "x" ++ show i @@ -336,7 +352,7 @@ -- | Build a frequency table from a ByteString. tally :: BC.ByteString -- ^ ByteString with which the FreqTrain will be built - -> FreqTrain -- ^ Resulting FreqTrain + -> FreqTrain -- ^ Resulting FreqTrain tally (PS _ _ 0) = empty tally !b = go 0 mempty where