ngram 0.1.0.0 → 0.1.0.1

raw patch · 7 files changed

+119/−89 lines, 7 filesnew-component:exe:ngramClassifierPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +22/−8
• app/NGramClassifier.hs +66/−0
• app/PPMClassifier.hs +0/−71
• ngram.cabal +6/−4
• src/Codec/Compression/PPM.hs +5/−0
• src/Codec/Compression/PPM/Trie.hs +1/−1
• src/Codec/Compression/PPM/Utils.hs +19/−5

@@ -1,16 +1,30 @@-# NGrams+# NGram  This is a code base for experimenting with various approaches to n-gram-based-text modeling.  To get started, run:+text modeling. -```bash+## Compiling++First install [Stack](https://docs.haskellstack.org) somewhere on your `PATH`.  For example, for `~/.local/bin`:++```+wget https://get.haskellstack.org/stable/linux-x86_64.tar.gz -O -|tar xpfz - -C /tmp+cp /tmp/stack-*/stack ~/.local/bin+rm -rf /tmp/stack-*+```++Then, while in the directory of this README file, run:++``` stack build-stack install ``` -This will build and install the library and binary commands.  Generally,-the commands expect data to be text files where each line has the format:+The first time this runs will take a while, 10 or 15 minutes, as it builds an entire Haskell environment from scratch.  Subsequent compilations are very fast. +## Running++Generally, the commands expect data to be text files where each line has the format:+ ``` ${id}<TAB>${label}<TAB>${text} ```@@ -43,14 +57,14 @@ tends to outperform them on short documents.  To create a PPM model, run:  ```bash-sh> ppm train --train train.txt --dev dev.txt --n 4 --modelFile model.gz+sh> stack exec -- ngramClassifier train --train train.txt --dev dev.txt --n 4 --modelFile model.gz Dev accuracy: 0.8566666666666667 ```  The model can then be applied to new data:  ```bash-sh> ppm apply --test test.txt --modelFile model.gz --n 4 --scoresFile scores.txt+sh> stack exec -- ngramClassifier apply --test test.txt --modelFile model.gz --n 4 --scoresFile scores.txt ```  The value of `--n` can also be less than the model size, which will run a bit 

@@ -0,0 +1,66 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ExplicitNamespaces #-}++module Main where++import Prelude hiding (lookup)+import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString as BSS+import qualified Data.Maybe as M+import qualified Data.List as L+import qualified Data.Text.Lazy as T+import qualified Data.Text.Lazy.IO as T+import qualified Data.Text.Lazy.Encoding as T+import Codec.Compression.GZip (compress, decompress)+import Options.Generic (Generic, ParseRecord, Unwrapped, Wrapped, unwrapRecord, (:::), type (<?>)(..))+import Control.Monad (join, liftM)+import qualified Data.Map as Map+import System.IO (withFile, hPutStr, IOMode(..))+import Codec.Compression.PPM (fromSequences, Model, classifySequence, scoreSequence)+import Codec.Compression.PPM.Utils (lineToInstance, accuracy, microFScore, macroFScore)+import Data.Serialize (encodeLazy, decodeLazy)+import Data.Serialize.Text++data Parameters w = Train { train :: w ::: String <?> "Train file"+                          , dev :: w ::: String <?> "Development file"+                          , n :: w ::: Int <?> "Maximum context size"+                          , modelFile :: w ::: String <?> "Model file (output or input, depending on whether training or testing, respectively)"+                          }+                  | Apply { modelFile :: w ::: String <?> "Model file (output or input, depending on whether training or testing, respectively)"+                          , n :: w ::: Int <?> "Maximum context size"                          +                          , test :: w ::: String <?> "Test file"+                          , scoresFile :: w ::: String <?> "Output file for scores"+                          }+  deriving (Generic)                              ++instance ParseRecord (Parameters Wrapped)+deriving instance Show (Parameters Unwrapped)++evaluateModel :: Model T.Text Char -> Int -> [(T.Text, [Char])] -> Double+evaluateModel model n xs = accuracy golds guesses+  where+    golds = map fst xs+    guesses = map (classifySequence model n . snd) xs++main :: IO ()+main = do+  ps <- unwrapRecord "Do PPM-related stuff: all inputs should be tab-separated lines of the form  ID<TAB>LABEL<TAB>TEXT  Specify a subcommand with '--help' to see its options."  +  case ps of+    Train {..} -> do+      trainInstances <- map lineToInstance <$> (liftM T.lines . liftM T.strip . T.readFile) train+      let model = fromSequences n trainInstances+      devInstances <- map lineToInstance <$> (liftM T.lines . liftM T.strip . T.readFile) dev+      print $ evaluateModel model n devInstances+      withFile modelFile WriteMode (\ h -> BS.hPutStr h ((compress . encodeLazy) model))+    Apply {..} -> do+      testInstances <- map lineToInstance <$> (liftM T.lines . liftM T.strip . T.readFile) test+      loader <- (decodeLazy . decompress) <$> BS.readFile modelFile :: IO (Either String (Model T.Text Char))      +      case loader of+        Right model -> print $ evaluateModel model n testInstances+        Left error -> print error

@@ -1,71 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ExplicitNamespaces #-}--module Main where--import Prelude hiding (lookup)-import qualified Data.ByteString.Lazy as BS-import qualified Data.ByteString as BSS-import qualified Data.Maybe as M-import qualified Data.List as L-import qualified Data.Text.Lazy as T-import qualified Data.Text.Lazy.IO as T-import qualified Data.Text.Lazy.Encoding as T-import Codec.Compression.GZip (compress, decompress)-import Options.Generic (Generic, ParseRecord, Unwrapped, Wrapped, unwrapRecord, (:::), type (<?>)(..))-import Control.Monad (join, liftM)-import qualified Data.Map as Map-import System.IO (withFile, hPutStr, IOMode(..))-import Codec.Compression.PPM (fromSequences, Model, classifySequence, scoreSequence)-import Codec.Compression.PPM.Utils (lineToInstance)-import Data.Serialize (encodeLazy, decodeLazy)-import Data.Serialize.Text--data Parameters w = Train { train :: w ::: String <?> "Train file"-                          , dev :: w ::: String <?> "Development file (mutually exclusive with --n, which takes precendence)"-                          , n :: w ::: Int <?> "Maximum context size (mutually exclusive with --dev, this option takes precedence)"-                          , modelFile :: w ::: String <?> "Model file (output or input, depending on whether training or testing, respectively)"-                          }-                  | Apply { modelFile :: w ::: String <?> "Model file (output or input, depending on whether training or testing, respectively)"-                          , n :: w ::: Int <?> "Maximum context size (mutually exclusive with --dev, this option takes precedence)"                          -                          , test :: w ::: String <?> "Test file"-                          , scoresFile :: w ::: String <?> "Output file for scores"-                          }-  deriving (Generic)                              -                                                            -instance ParseRecord (Parameters Wrapped)-deriving instance Show (Parameters Unwrapped)--evaluateModel :: Model T.Text Char -> Int -> [(T.Text, [Char])] -> Double-evaluateModel m n xs = accuracy-  where-    gold = map fst xs-    guess = map (classifySequence m n) (map snd xs)-    correct = length $ [x | (x, y) <- zip gold guess, x == y]-    accuracy = (fromIntegral correct) / (fromIntegral $ length gold)---main :: IO ()-main = do-  ps <- unwrapRecord "Do PPM-related stuff: all inputs should be tab-separated lines of the form  ID<TAB>LABEL<TAB>TEXT  Specify a subcommand with '--help' to see its options."  -  case ps of-    Train {..} -> do-      trainInstances <- map lineToInstance <$> (liftM T.lines . liftM T.strip . T.readFile) train-      let model = fromSequences n trainInstances-      devInstances <- map lineToInstance <$> (liftM T.lines . liftM T.strip . T.readFile) dev-      print $ evaluateModel model n devInstances-      withFile modelFile WriteMode (\ h -> BS.hPutStr h ((compress . encodeLazy) model))-    Apply {..} -> do-      testInstances <- map lineToInstance <$> (liftM T.lines . liftM T.strip . T.readFile) test-      loader <- (decodeLazy . decompress) <$> BS.readFile modelFile :: IO (Either String (Model T.Text Char))      -      case loader of-        Right model -> print $ evaluateModel model n testInstances-        Left error -> print error-      -

@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: af4ceddbe5e5c69c25bcb8f6b1751761dbfff6d66511ba80f8b6cde5cba29c91+-- hash: 1aef9b38a31cf7e0b80ac476b1679088314bbb55e0168d149928c083323d151c  name:           ngram-version:        0.1.0.0+version:        0.1.0.1 synopsis:       Ngram models for compressing and classifying text. description:    A library and collection of commands for training, evaluating, and applying n-gram-based sequence models. category:       natural-language-processing, machine-learning@@ -35,6 +35,7 @@       Paths_ngram   hs-source-dirs:       src+  default-extensions: Strict StrictData   build-depends:       base >=4.7 && <5     , cereal >=0.5.4.0@@ -43,12 +44,13 @@     , text >=1.2.2   default-language: Haskell2010 -executable ppm-  main-is: PPMClassifier.hs+executable ngramClassifier+  main-is: NGramClassifier.hs   other-modules:       Paths_ngram   hs-source-dirs:       app+  default-extensions: Strict StrictData   ghc-options: -threaded -rtsopts   build-depends:       base >=4.7 && <5

@@ -40,12 +40,14 @@  type Model l a = Trie (Entry a) (Map l Integer) + classifySequence :: (Ord l, Ord a, Show l, Show a) => Trie (Entry a) (Map l Integer) -> Int -> [a] -> l classifySequence m n xs = label   where     scores = Map.toList $ scoreSequence m n xs     label = fst $ maximumBy (\(_, x) (_, y) -> compare x y) scores + scoreSequence :: (Ord l, Ord a, Show l, Show a) => Trie (Entry a) (Map l Integer) -> Int -> [a] -> Map l Double scoreSequence m n xs = total   where@@ -54,9 +56,11 @@     scores = map (scoreGram m) grams     total = Map.unionsWith (+) (scores) + oneTerm :: (Ord l, Show l) => Map l Integer -> Map l Integer -> Map l (Maybe Float) oneTerm numers denoms = Map.empty + scoreGram :: (Ord l, Ord a, Show l, Show a) => Trie (Entry a) (Map l Integer) -> [(Entry a)] -> Map l Double scoreGram tr ns@(_:ns') = Map.map (toProb 256) vals   where@@ -95,3 +99,4 @@   where     xs' = map (\(l, is) -> [(l, x) | x <- revWindows n (replicate (n - 1) Start ++ (map Entry is))]) xs     model = Trie.labeledSuffixCountTrie (concat xs')+    

@@ -22,9 +22,9 @@ import qualified Data.List as L import Data.Foldable (toList) import qualified Data.Maybe as Maybe---import Codec.Compression.PPM.Utils (windows) import Data.Serialize (Serialize) import GHC.Generics (Generic)+  -- | Trie nodes may have an optional arbitrary value, and each edge is --   associated with a particular value seen in the input sequences.

@@ -3,6 +3,9 @@  module Codec.Compression.PPM.Utils ( lineToInstance                                    , revWindows+                                   , accuracy+                                   , microFScore+                                   , macroFScore                                    ) where  @@ -12,17 +15,28 @@ import Data.Foldable (toList)  ---classify :: [+-- | Calculates accuracy+accuracy :: (Eq a) => [a] -> [a] -> Double+accuracy golds guesses = correct / total+  where+    total = (fromIntegral . length) golds+    correct = (fromIntegral . length) $ [x | (x, y) <- zip golds guesses, x == y]   -- | Calculates micro F-Score-microFScore :: [a] -> [a] -> Double-microFScore guess gold = error "unimp"+microFScore :: (Eq a) => [a] -> [a] -> Double+microFScore guess gold = 1.0+  where+    precs = []+    recs = []   -- | Calculates macro F-Score-macroFScore :: [a] -> [a] -> Double-macroFScore guess gold = error "unimp"+macroFScore :: (Eq a) => [a] -> [a] -> Double+macroFScore guess gold = 1.0+  where+    precs = []+    recs = []   -- | Splits a line of format ID<TAB>LABEL<TAB>TEXT into a