chatter 0.3.0.1 → 0.4.0.0

raw patch · 21 files changed

+745/−79 lines, 21 filesnew-component:exe:tagPOSnew-component:exe:trainChunkernew-component:exe:trainPOSbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• appsrc/ChunkTrainer.hs +31/−0
• appsrc/POSTrainer.hs +37/−0
• appsrc/Trainer.hs +0/−32
• chatter.cabal +29/−8
• data/models/README +17/−3
• data/models/brown-train.model.gz too large to diff
• data/models/brown.pos.model.gz too large to diff
• data/models/conll2000.chunk.model.gz binary
• data/models/conll2000.pos.model.gz too large to diff
• src/NLP/Chunk.hs +73/−0
• src/NLP/Chunk/AvgPerceptronChunker.hs +204/−0
• src/NLP/Corpora/Brown.hs +15/−9
• src/NLP/Corpora/Conll.hs +148/−0
• src/NLP/POS.hs +17/−3
• src/NLP/POS/AvgPerceptronTagger.hs +0/−2
• src/NLP/Types/General.hs +5/−0
• src/NLP/Types/IOB.hs +111/−0
• src/NLP/Types/Tags.hs +11/−1
• src/NLP/Types/Tree.hs +33/−13
• tests/src/IntegrationTests.hs +8/−2
• tests/src/Main.hs +6/−6

@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}+module ChunkTrainer where++import qualified Data.Text as T+import qualified Data.Text.IO as T+import System.Environment (getArgs)++import NLP.POS.AvgPerceptron (emptyPerceptron)+import qualified NLP.Chunk.AvgPerceptronChunker as Avg+import NLP.Chunk (train, saveChunker)+import NLP.Types.IOB++import qualified NLP.Corpora.Conll as C++main :: IO ()+main = do+  args <- getArgs+  let output = last args+      corpora = init args++      avgPerChunker :: Avg.Chunker C.Chunk C.Tag+      avgPerChunker = Avg.mkChunker emptyPerceptron++  rawCorpus <- mapM T.readFile corpora+  let eChunkedCorpora = parseIOB $ T.concat rawCorpus+  case eChunkedCorpora of+    Left err -> T.putStrLn err+    Right chunkedCorpora -> do+      chunker <- train avgPerChunker $ map toChunkTree chunkedCorpora+      saveChunker chunker output+

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+module POSTrainer where++import qualified Data.Map as Map+import qualified Data.Text as T+import qualified Data.Text.IO as T+import System.Environment (getArgs)++import qualified NLP.POS.AvgPerceptronTagger as Avg+import qualified NLP.POS.UnambiguousTagger as UT+import NLP.POS (saveTagger, train)+import NLP.Types (POSTagger, Error)+import NLP.Types.IOB++import qualified NLP.Corpora.Conll as C++main :: IO ()+main = do+  args <- getArgs+  let output = last args+      corpora = init args++      avgPerTagger :: POSTagger C.Tag+      avgPerTagger = Avg.mkTagger Avg.emptyPerceptron Nothing++      initTagger :: POSTagger C.Tag+      initTagger   = UT.mkTagger Map.empty (Just avgPerTagger)+  rawCorpus <- mapM T.readFile corpora+  let eCorpora :: Either Error [[IOBChunk C.Chunk C.Tag]]+      eCorpora = parseIOB $ T.concat rawCorpus+  case eCorpora of+    Left err -> T.putStrLn err+    Right taggedCorpora -> do+     let taggedSentences = map toTaggedSentence taggedCorpora+     tagger <- train initTagger taggedSentences+     saveTagger tagger output+

@@ -1,32 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Trainer where--import qualified Data.Map as Map-import qualified Data.Text as T-import qualified Data.Text.IO as T-import System.Environment (getArgs)--import qualified NLP.POS.AvgPerceptronTagger as Avg-import qualified NLP.POS.UnambiguousTagger as UT-import NLP.POS (saveTagger, train)-import NLP.Corpora.Parsing-import NLP.Types (POSTagger)--import qualified NLP.Corpora.Brown as B--main :: IO ()-main = do-  args <- getArgs-  let output = last args-      corpora = init args--      avgPerTagger :: POSTagger B.Tag-      avgPerTagger = Avg.mkTagger Avg.emptyPerceptron Nothing--      initTagger :: POSTagger B.Tag-      initTagger   = UT.mkTagger Map.empty (Just avgPerTagger)-  rawCorpus <- mapM T.readFile corpora-  let taggedCorpora = map readPOS $ concatMap T.lines $ rawCorpus-  tagger <- train initTagger taggedCorpora-  saveTagger tagger output-

@@ -1,5 +1,5 @@ name:                chatter-version:             0.3.0.1+version:             0.4.0.0 synopsis:            A library of simple NLP algorithms. description:         chatter is a collection of simple Natural Language                      Processing algorithms.@@ -27,7 +27,9 @@ Extra-Source-Files:  changelog.md  data-files:          ./data/models/README-                     ./data/models/brown-train.model.gz+                     ./data/models/brown.pos.model.gz+                     ./data/models/conll2000.pos.model.gz+                     ./data/models/conll2000.chunk.model.gz  source-repository head   type:     git@@ -44,14 +46,18 @@                      NLP.POS.AvgPerceptronTagger                      NLP.POS.LiteralTagger                      NLP.POS.UnambiguousTagger+                     NLP.Chunk+                     NLP.Chunk.AvgPerceptronChunker                      NLP.Types                      NLP.Types.General+                     NLP.Types.IOB                      NLP.Types.Tags                      NLP.Types.Tree                      NLP.Tokenize.Chatter                      NLP.Corpora.Parsing                      NLP.Corpora.Email                      NLP.Corpora.Brown+                     NLP.Corpora.Conll                      NLP.Similarity.VectorSim                      NLP.Extraction.Parsec                      NLP.Extraction.Examples.ParsecExamples@@ -85,10 +91,10 @@   -   ghc-options:      -Wall+   ghc-options:      -Wall -auto-all -caf-all  -Executable tag+Executable tagPOS    default-language: Haskell2010    Main-Is:          Tagger.hs    hs-source-dirs:   appsrc@@ -102,9 +108,9 @@     ghc-options:      -Wall -main-is Tagger -rtsopts -Executable train+Executable trainPOS    default-language: Haskell2010-   Main-Is:          Trainer.hs+   Main-Is:          POSTrainer.hs    hs-source-dirs:   appsrc     Build-depends:    chatter,@@ -115,8 +121,23 @@                      cereal >= 0.4.0.1,                      containers >= 0.5.0.0 -   ghc-options:      -Wall -main-is Trainer -rtsopts+   ghc-options:      -Wall -main-is POSTrainer -rtsopts +Executable trainChunker+   default-language: Haskell2010+   Main-Is:          ChunkTrainer.hs+   hs-source-dirs:   appsrc++   Build-depends:    chatter,+                     filepath >= 1.3.0.1,+                     text >= 0.11.3.0,+                     base >= 4.6 && <= 6,+                     bytestring >= 0.10.0.0,+                     cereal >= 0.4.0.1,+                     containers >= 0.5.0.0++   ghc-options:      -Wall -main-is ChunkTrainer -rtsopts+ Executable eval    default-language: Haskell2010    Main-Is:          Evaluate.hs@@ -188,4 +209,4 @@                      quickcheck-instances,                      containers -   ghc-options:      -Wall+   ghc-options:      -Wall -auto-all -caf-all

@@ -1,7 +1,6 @@---brown-train.model.gz ---------------------------------------------------------------------+brown.pos.model.gz+---------------------------------------------------------------------  Averaged Perceptron tagger and Unambiguous Tagger trained on most of the Brown corpus; the following files were held out for testing:@@ -12,3 +11,18 @@   cp01 cp03 cr02  The remainder of the Brown corpus was used to train this model.+++---------------------------------------------------------------------+conll2000.pos.model.gz+---------------------------------------------------------------------++Averaged Perceptron tagger and Unambiguous Tagger trained on the Conll+2000 training set.+++---------------------------------------------------------------------+conll2000.chunk.model.gz+---------------------------------------------------------------------++Averaged Perceptron Chunker trained on the Conll 2000 training set.

file too large to diff

file too large to diff

binary file changed (absent → 204463 bytes)

file too large to diff

@@ -0,0 +1,73 @@+module NLP.Chunk+where++import           Codec.Compression.GZip      (decompress)+import           Data.ByteString             (ByteString)+import qualified Data.ByteString             as BS+import qualified Data.ByteString.Lazy        as LBS+import           Data.List                   (isSuffixOf)+import           Data.Map                    (Map)+import qualified Data.Map                    as Map+import           Data.Serialize              (decode, encode)+import           System.FilePath             ((</>))++import           NLP.Types+import           NLP.Chunk.AvgPerceptronChunker+import qualified NLP.Chunk.AvgPerceptronChunker as Avg++import qualified NLP.Corpora.Conll as C++import           Paths_chatter++defaultChunker :: IO (Chunker C.Chunk C.Tag)+defaultChunker = conllChunker++conllChunker :: IO (Chunker C.Chunk C.Tag)+conllChunker = do+  dir <- getDataDir+  loadChunker (dir </> "data" </> "models" </> "conll2000.chunk.model.gz")++train :: (ChunkTag c, Tag t) => Chunker c t -> [ChunkedSentence c t] -> IO (Chunker c t)+train ch exs = chTrainer ch exs++-- | The default table of tagger IDs to readTagger functions.  Each+-- tagger packaged with Chatter should have an entry here.  By+-- convention, the IDs use are the fully qualified module name of the+-- tagger package.+chunkerTable :: (ChunkTag c, Tag t) => Map ByteString+               (ByteString -> Either String (Chunker c t))+chunkerTable = Map.fromList+  [ (Avg.chunkerID, Avg.readChunker)+  ]++-- | Store a 'Chunker' to disk.+saveChunker :: (ChunkTag c, Tag t) => Chunker c t -> FilePath -> IO ()+saveChunker chunker file = BS.writeFile file (serialize chunker)++-- | Load a 'Chunker' from disk, optionally gunzipping if+-- needed. (based on file extension)+loadChunker :: (ChunkTag c, Tag t) => FilePath -> IO (Chunker c t)+loadChunker file = do+  content <- getContent file+  case deserialize chunkerTable content of+    Left err -> error err+    Right chunker -> return chunker+  where+    getContent :: FilePath -> IO ByteString+    getContent f | ".gz" `isSuffixOf` file = fmap (LBS.toStrict . decompress) $ LBS.readFile f+                 | otherwise               = BS.readFile f+++serialize :: (ChunkTag c, Tag t) => Chunker c t -> ByteString+serialize chunker = encode ( chId chunker, chSerialize chunker)++deserialize :: (ChunkTag c, Tag t) =>+               Map ByteString+                  (ByteString -> Either String (Chunker c t))+            -> ByteString+            -> Either String (Chunker c t)+deserialize table bs = do+  (theID, payload) <- decode bs+  case Map.lookup theID table of+    Nothing -> Left ("Could not find ID in Chunker function map: " ++ show theID)+    Just fn -> fn payload

@@ -0,0 +1,204 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Avegeraged Perceptron Chunker+--+module NLP.Chunk.AvgPerceptronChunker+  ( mkChunker+  , trainInt+  , chunk+  , chunkSentence+  , Chunker(..)+  , chunkerID+  , readChunker+  )+where++import NLP.POS.AvgPerceptron ( Perceptron, Feature(..)+                             , Class(..), predict, update+                             , averageWeights)+import NLP.Types++import Data.ByteString (ByteString)+import Data.List (foldl', group)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Either (rights)+import Data.Maybe (fromMaybe)+import Data.Serialize (encode, decode)+import Data.Text (Text)+import qualified Data.Text as T++import System.Random.Shuffle (shuffleM)++-- | The type of Chunkers, incorporates chunking, training,+-- serilazitaion and unique IDs for deserialization.+data Chunker c t = Chunker+  { chChunker :: [TaggedSentence t] -> [ChunkedSentence c t]+  , chTrainer :: [ChunkedSentence c t] -> IO (Chunker c t)+  , chSerialize :: ByteString+  , chId :: ByteString+  }++-- | The unique ID for this implementation of a 'Chunker'+chunkerID :: ByteString+chunkerID = "NLP.Chunk.AvgPerceptronChunker"++-- | deserialize an 'AvgPerceptronChunker' from a 'ByteString'.+readChunker :: (ChunkTag c, Tag t) => ByteString -> Either String (Chunker c t)+readChunker bs = do+  model <- decode bs+  return $ mkChunker model++itterations :: Int+itterations = 5++-- | Create a chunker from a 'Perceptron'.+mkChunker :: (ChunkTag c, Tag t) => Perceptron -> Chunker c t+mkChunker per = Chunker { chChunker = chunk per+                        , chTrainer = \exs -> do+                            newPer <- trainInt itterations per exs+                            return $ mkChunker newPer+                        , chSerialize = encode per+                        , chId = chunkerID+                        }+++-- | Chunk a list of POS-tagged sentence, generating a parse tree.+chunk :: (ChunkTag c, Tag t) => Perceptron -> [TaggedSentence t] -> [ChunkedSentence c t]+chunk per corpus = map (chunkSentence per) corpus++-- | Chunk a single POS-tagged sentence.+chunkSentence :: (ChunkTag c, Tag t) => Perceptron -> TaggedSentence t -> ChunkedSentence c t+chunkSentence per (TaggedSent sent) = let++  chunks = [Class "-START-"] ++ map (predictChunk per) features++  features = zipWith3 (getFeatures sent)+             [0..]+             sent+             chunks++  chunkTags = map (\(Class c) -> parseChunk $ T.pack c) $ drop 1 chunks++  in toTree (rights $ chunkTags) sent -- possible hidden failures.++predictChunk :: Perceptron -> Map Feature Int -> Class+predictChunk model feats =+  let predicted = predict model feats+      theClass = fromMaybe (Class "O") predicted+  in theClass++-- | Turn an IOB result into a tree.+toTree :: (ChunkTag c, Tag t) => [c] -> [POS t] -> ChunkedSentence c t+toTree chunks tags =+  let groups = map (\g -> (head g, length g)) $ group chunks++      groupTags []     _    = []+      groupTags ((g, c):gs) tags = (g, take c tags):(groupTags gs $ drop c tags)++  in ChunkedSent $ concatMap toChunkOr (groupTags groups tags)++toChunkOr :: (ChunkTag c, Tag t) => (c, [POS t]) -> [ChunkOr c t]+toChunkOr (c, tags) | c == notChunk = map POS_CN tags+                    | otherwise     = [Chunk_CN (Chunk c $ map POS_CN tags)]+++trainInt :: (ChunkTag c, Tag t) =>+            Int -- ^ The number of times to iterate over the training+                -- data, randomly shuffling after each iteration. (@5@+                -- is a reasonable choice.)+         -> Perceptron -- ^ The 'Perceptron' to train.+         -> [ChunkedSentence c t] -- ^ The training data. (A list of @[(Text, Tag)]@'s)+         -> IO Perceptron    -- ^ A trained perceptron.  IO is needed+                             -- for randomization.+trainInt itr per examples = trainCls itr per $ toClassLst $ map unzipChunks examples++toClassLst :: (ChunkTag c, Tag t) => [(TaggedSentence t, [c])] -> [(TaggedSentence t, [Class])]+toClassLst tagged = map (\(x, y)->(x, map (Class . T.unpack . fromChunk) y)) tagged++-- | Copied directly from the AvgPerceptronTagger; should be generalized?+trainCls :: Tag t => Int -> Perceptron -> [(TaggedSentence t, [Class])] -> IO Perceptron+trainCls itr per examples = do+  trainingSet <- shuffleM $ concat $ take itr $ repeat examples+  return $ averageWeights $ foldl' trainSentence per trainingSet++-- | start markers to ensure all features in context are valid,+-- even for the first "real" tokens.+startToks :: Tag t => [POS t]+startToks = [POS startTag (Token "-START-")]++-- | end markers to ensure all features are valid, even for+-- the last "real" tokens.+endToks :: Tag t => [POS t]+endToks = [POS endTag (Token "-END-")]++-- | Train on one sentence.+trainSentence :: Tag t => Perceptron -> (TaggedSentence t, [Class]) -> Perceptron+trainSentence per (TaggedSent sent, ts) = let++  -- This class needs to match the start token.+  tags = [Class "-START-"] ++ ts++  features = zipWith3 (getFeatures sent)+                         [0..] -- index+                         sent  -- words (well, POS values)+                         tags  -- predicted class of previous word.++  fn :: Perceptron -> (Map Feature Int, Class) -> Perceptron+  fn model (feats, truth) = let+    guess = predictChunk model feats+    in update model truth guess $ Map.keys feats++  in foldl' fn per (zip features ts)+++-- >>> def npchunk_features(sentence, i, history):+-- ...     word, pos = sentence[i]+-- ...     if i == 0:+-- ...         prevword, prevpos = "<START>", "<START>"+-- ...     else:+-- ...         prevword, prevpos = sentence[i-1]+-- ...     if i == len(sentence)-1:+-- ...         nextword, nextpos = "<END>", "<END>"+-- ...     else:+-- ...         nextword, nextpos = sentence[i+1]+-- ...     return {"pos": pos,+-- ...             "word": word,+-- ...             "prevpos": prevpos,+-- ...             "nextpos": nextpos, [1]+-- ...             "prevpos+pos": "%s+%s" % (prevpos, pos),  [2]+-- ...             "pos+nextpos": "%s+%s" % (pos, nextpos),+-- ...             "tags-since-dt": tags_since_dt(sentence, i)}+getFeatures :: Tag t =>+               [POS t] -- ^ The full sentence that this word is located in.+            -> Int   -- ^ The index of the current word.+            -> POS t -- ^ The current word/tag pair.+            -> Class -- ^ The predicted class of the previous word.+            -> Map Feature Int+getFeatures tagged idx word prev = let+  context = startToks ++ tagged ++ endToks++  i = idx + 1 -- length startToks++  add :: Map Feature Int -> [Text] -> Map Feature Int+  add m args = Map.alter increment (mkFeature $ T.intercalate " " args) m++  increment :: Maybe Int -> Maybe Int+  increment Nothing  = Just 1+  increment (Just w) = Just (w + 1)++  features :: [[Text]]+  features = [ ["pos",         showPOStag word]+             , ["word",        showPOStok word]+             , ["prevpos",     showPOStag (context!!(i-1))]+             , ["prevpos+pos", T.intercalate "+" $ map showPOStag+                                 [ context!!(i-1), word ]+               ]+             , ["pos+nextpos", T.intercalate "+" $ map showPOStag+                                 [word, context!!(i+1) ]+               ]+--             , ["tags-since-dt", ""]+             ]+  in foldl' add Map.empty features++mkFeature :: Text -> Feature+mkFeature txt = Feat $ T.copy txt

@@ -11,7 +11,7 @@ import Data.Serialize (Serialize) import qualified Data.Text as T import Data.Text (Text)-import Text.Read (readMaybe)+import Text.Read (readEither) import Test.QuickCheck.Arbitrary (Arbitrary(..)) import Test.QuickCheck.Gen (elements) @@ -24,10 +24,11 @@            | C_VP -- ^ Verb Phrase.            | C_PP -- ^ Prepositional Phrase.            | C_CL -- ^ Clause.-  deriving (Read, Show, Ord, Eq, Generic, Enum)+           | C_O  -- ^ "Out" not a chunk.+  deriving (Read, Show, Ord, Eq, Generic, Enum, Bounded)  instance Arbitrary Chunk where-  arbitrary = elements [C_NP ..]+  arbitrary = elements [minBound ..]  instance Serialize Chunk @@ -45,8 +46,11 @@    tagTerm = showBrownTag +  startTag = START+  endTag = END+ instance Arbitrary Tag where-  arbitrary = elements [Op_Paren ..]+  arbitrary = elements [minBound ..]  parseBrownTag :: Text -> Either Error Tag parseBrownTag "(" = Right Op_Paren@@ -58,9 +62,7 @@ parseBrownTag ":" = Right Colon parseBrownTag txt =   let normalized = replaceAll tagTxtPatterns (T.toUpper txt)-  in case readMaybe $ T.unpack normalized of-       Nothing -> Left (T.append "Could not parse: " txt)-       Just  t -> Right t+  in toEitherErr (readEither $ T.unpack normalized)   -- | Order matters here: The patterns are replaced in reverse order@@ -90,8 +92,12 @@  instance T.ChunkTag Chunk where   fromChunk = T.pack . show+  parseChunk txt = toEitherErr $ readEither (T.unpack $ T.append "C_" txt)+  notChunk = C_O -data Tag = Op_Paren -- ^ (+data Tag = START -- ^ START tag, used in training.+         | END -- ^ END tag, used in training.+         | Op_Paren -- ^ (          | Cl_Paren -- ^ )          | Negator -- ^ *, not n't          | Comma -- ^ ,@@ -670,4 +676,4 @@          | WRB_pl_IN -- ^ WH-adverb + preposition e.g.; why'n          | WRB_pl_MD -- ^ WH-adverb + modal auxillary e.g.; where'd          | Unk       -- ^ Unknown.-  deriving (Read, Show, Ord, Eq, Generic, Enum)+  deriving (Read, Show, Ord, Eq, Generic, Enum, Bounded)

@@ -0,0 +1,148 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+-- | Data types representing the POS tags and Chunk tags derived from+-- the Conll2000 training corpus.+module NLP.Corpora.Conll where++import Data.Serialize (Serialize)+import qualified Data.Text as T+import Data.Text (Text)+import Text.Read (readEither)+import Test.QuickCheck.Arbitrary (Arbitrary(..))+import Test.QuickCheck.Gen (elements)++import GHC.Generics++import qualified NLP.Types.Tags as T+import NLP.Types.General++data Chunk = ADJP+           | ADVP+           | CONJP+           | INTJ+           | LST+           | NP -- ^ Noun Phrase.+           | PP -- ^ Prepositional Phrase.+           | PRT+           | SBAR+           | UCP+           | VP -- ^ Verb Phrase.+           | O -- ^ "out"; not a chunk.+  deriving (Read, Show, Ord, Eq, Generic, Enum, Bounded)++instance Arbitrary Chunk where+  arbitrary = elements [minBound..]++instance Serialize Chunk++instance Serialize Tag++instance T.Tag Tag where+  fromTag = showTag++  parseTag txt = case readTag txt of+                   Left  _ -> Unk+                   Right t -> t++  -- | Constant tag for "unknown"+  tagUNK = Unk++  tagTerm = showTag++  startTag = START+  endTag = END++instance Arbitrary Tag where+  arbitrary = elements [minBound ..]++readTag :: Text -> Either Error Tag+readTag "#" = Right Hash+readTag "$" = Right Dollar+readTag "(" = Right Op_Paren+readTag ")" = Right Cl_Paren+readTag "''" = Right CloseDQuote+readTag "``" = Right OpenDQuote+readTag "," = Right Comma+readTag "." = Right Term+readTag ":" = Right Colon+readTag txt =+  let normalized = replaceAll tagTxtPatterns (T.toUpper txt)+  in toEitherErr (readEither $ T.unpack normalized)++-- | Order matters here: The patterns are replaced in reverse order+-- when generating tags, and in top-to-bottom when generating tags.+tagTxtPatterns :: [(Text, Text)]+tagTxtPatterns = [ ("$", "dollar")+                 ]++reversePatterns :: [(Text, Text)]+reversePatterns = map (\(x,y) -> (y,x)) tagTxtPatterns++showTag :: Tag -> Text+showTag Hash = "#"+showTag Op_Paren = "("+showTag Cl_Paren = ")"+showTag CloseDQuote = "''"+showTag OpenDQuote = "``"+showTag Dollar = "$"+showTag Comma = ","+showTag Term = "."+showTag Colon = ":"+showTag tag = replaceAll reversePatterns (T.pack $ show tag)++replaceAll :: [(Text, Text)] -> (Text -> Text)+replaceAll patterns = foldl (.) id (map (uncurry T.replace) patterns)++instance T.ChunkTag Chunk where+  fromChunk = T.pack . show+  parseChunk txt = toEitherErr $ readEither $ T.unpack txt+  notChunk = O++data Tag = START -- ^ START tag, used in training.+         | END -- ^ END tag, used in training.+         | Hash -- ^ #+         | Dollar -- ^ $+         | CloseDQuote -- ^ ''+         | OpenDQuote -- ^ ``+         | Op_Paren -- ^ (+         | Cl_Paren -- ^ )+         | Comma -- ^ ,+         | Term -- ^ . Sentence Terminator+         | Colon -- ^ :+         | CC+         | CD+         | DT+         | EX+         | FW+         | IN+         | JJ+         | JJR+         | JJS+         | MD+         | NN+         | NNP+         | NNPS+         | NNS+         | PDT+         | POS+         | PRP+         | PRPdollar+         | RB+         | RBR+         | RBS+         | RP+         | SYM+         | TO+         | UH+         | VB+         | VBD+         | VBG+         | VBN+         | VBP+         | VBZ+         | WDT+         | WP+         | WPdollar+         | WRB+         | Unk+  deriving (Read, Show, Ord, Eq, Generic, Enum, Bounded)

@@ -34,6 +34,8 @@   , saveTagger   , loadTagger   , defaultTagger+  , conllTagger+  , brownTagger   ) where @@ -62,13 +64,25 @@ import qualified NLP.POS.UnambiguousTagger   as UT  import qualified NLP.Corpora.Brown as B+import qualified NLP.Corpora.Conll as C  import           Paths_chatter -defaultTagger :: IO (POSTagger B.Tag)-defaultTagger = do+-- | A basic POS tagger.+defaultTagger :: IO (POSTagger C.Tag)+defaultTagger = conllTagger++-- | A POS tagger that has been trained on the Conll 2000 POS tags.+conllTagger :: IO (POSTagger C.Tag)+conllTagger = do   dir <- getDataDir-  loadTagger (dir </> "data" </> "models" </> "brown-train.model.gz")+  loadTagger (dir </> "data" </> "models" </> "conll2000.pos.model.gz")++-- | A POS tagger trained on a subset of the Brown corpus.+brownTagger :: IO (POSTagger B.Tag)+brownTagger = do+  dir <- getDataDir+  loadTagger (dir </> "data" </> "models" </> "brown.pos.model.gz")  -- | The default table of tagger IDs to readTagger functions.  Each -- tagger packaged with Chatter should have an entry here.  By

@@ -212,8 +212,6 @@          -> IO Perceptron    -- ^ A trained perceptron.  IO is needed                              -- for randomization. trainInt itr per examples = trainCls itr per $ toClassLst $ map unzipTags examples-  -- where-  --   toSentPair (xs, ts) = (Sent $ map Token xs, ts)  toClassLst :: Tag t => [(Sentence, [t])] -> [(Sentence, [Class])] toClassLst tagged = map (\(x, y)->(x, map (Class . T.unpack . fromTag) y)) tagged

@@ -5,12 +5,17 @@  import Data.Serialize (Serialize) import Data.Text (Text)+import qualified Data.Text as T import GHC.Generics  import Test.QuickCheck (Arbitrary(..), elements)  -- | Just a handy alias for Text type Error = Text++toEitherErr :: Either String a -> Either Error a+toEitherErr (Left s) = Left (T.pack s)+toEitherErr (Right r) = Right r  -- | Boolean type to indicate case sensitivity for textual -- comparisons.

@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}+module NLP.Types.IOB where++import Prelude hiding (print)+import Control.Applicative ((<$>), (<*>))+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import qualified Data.Text as T++import Test.QuickCheck (Arbitrary(..), elements)+import Test.QuickCheck.Instances ()++import NLP.Types.Tags+import NLP.Types.Tree+import NLP.Types.General (Error)++-- | Data type to indicate IOB tags for chunking+data IOBChunk chunk tag = BChunk (POS tag) chunk -- ^ Beging marker.+                        | IChunk (POS tag) chunk -- ^ In chunk tag+                        | OChunk (POS tag) -- ^ Not in a chunk.+  deriving (Read, Show, Eq)++getPOS :: (ChunkTag c, Tag t) => IOBChunk c t -> POS t+getPOS (BChunk pos _) = pos+getPOS (IChunk pos _) = pos+getPOS (OChunk pos)   = pos++instance (ChunkTag c, Arbitrary c, Arbitrary t, Tag t) => Arbitrary (IOBChunk c t) where+  arbitrary = elements =<< do+                ic <- IChunk <$> arbitrary <*> arbitrary+                bc <- BChunk <$> arbitrary <*> arbitrary+                oc <- OChunk <$> arbitrary+                return [ic, bc, oc]++toTaggedSentence :: (ChunkTag c, Tag t) => [IOBChunk c t] -> TaggedSentence t+toTaggedSentence iobChunks = TaggedSent $ map getPOS iobChunks+++-- | Parse an IOB-chunk encoded line of text.+--+-- Assumes that the line has three space-delimeted entries, in the format:+-- > token POSTag IOBChunk+-- For example:+-- > > parseIOBLine "We PRP B-NP" :: IOBChunk B.Chunk B.Tag+-- > BChunk (POS B.PRP (Token "We")) B.C_NP+--+parseIOBLine :: (ChunkTag chunk, Tag tag) => Text -> Either Error (IOBChunk chunk tag)+parseIOBLine txt =+  let (tokTxt:tagTxt:iobTxt:_) = T.words txt+      token = Token tokTxt+      tag   = POS (parseTag tagTxt) token+  in iobBuilder iobTxt tag++iobBuilder :: (ChunkTag c, Tag t) => Text -> (POS t -> Either Error (IOBChunk c t))+iobBuilder iobTxt | "I-" `T.isPrefixOf` iobTxt = \tag -> (IChunk tag) <$> chunk+                  | "B-" `T.isPrefixOf` iobTxt = \tag -> (BChunk tag) <$> chunk+                  | otherwise                  = \tag -> Right (OChunk tag)+  where+    chunk = parseChunk (T.drop 2 iobTxt)+++-- | Turn an IOB result into a tree.+toChunkTree :: (ChunkTag c, Tag t) => [IOBChunk c t] -> ChunkedSentence c t+toChunkTree chunks = ChunkedSent $ toChunkOr chunks++  where+    toChunkOr :: (ChunkTag c, Tag t) => [IOBChunk c t] -> [ChunkOr c t]+    toChunkOr [] = []+    toChunkOr ((OChunk pos):rest)       = POS_CN pos : toChunkOr rest+    toChunkOr (ch:rest) = case ch of+      (BChunk pos chunk) -> (Chunk_CN (Chunk chunk children)) : toChunkOr theTail+      (IChunk pos chunk) -> (Chunk_CN (Chunk chunk children)) : toChunkOr theTail+      where+        (ichunks, theTail) = span isIChunk rest++        toPOScn (IChunk pos _) = Just $ POS_CN pos+        toPOScn _              = Nothing++    --    children :: [ChunkOr c t]+        children = mapMaybe toPOScn ichunks++        isIChunk (IChunk _ _) = True+        isIChunk _            = False++-- | Parse an IOB-encoded corpus.+parseIOB :: (ChunkTag chunk, Tag tag) => Text -> Either Error [[IOBChunk chunk tag]]+parseIOB corpora =+  let sentences = getSentences corpora+  in sequence $ map parseSentence sentences++parseSentence :: (ChunkTag chunk, Tag tag) => [Text] -> Either Error [IOBChunk chunk tag]+parseSentence input = sequence (map parseIOBLine input)++-- | Just split a body of text into lines, and then into "paragraphs".+-- Each resulting sub list is separated by empty lines in the original text.+--+-- e.g.;+-- > > getSentences "He\njumped\n.\n\nShe\njumped\n."+-- > [["He", "jumped", "."], ["She","jumped", "."]]+--+getSentences :: Text -> [[Text]]+getSentences corpora =+  let theLines = map T.strip $ T.lines corpora++      sentences :: [Text] -> [[Text]]+      sentences []      = []+      sentences ("":xs) = sentences xs+      sentences input   = let (sent, rest) = break (== T.empty) input+                          in (sent:sentences rest)++  in sentences theLines

@@ -13,12 +13,16 @@ import Test.QuickCheck (Arbitrary(..), NonEmptyList(..)) import Test.QuickCheck.Instances () +import NLP.Types.General (Error)+ -- | The class of things that can be regarded as 'chunks'; Chunk tags -- are much like POS tags, but should not be confused. Generally, -- chunks distinguish between different phrasal categories (e.g.; Noun -- Phrases, Verb Phrases, Prepositional Phrases, etc..) class (Ord a, Eq a, Read a, Show a, Generic a, Serialize a) => ChunkTag a where   fromChunk :: a -> Text+  parseChunk :: Text -> Either Error a+  notChunk :: a  -- | The class of POS Tags. --@@ -40,7 +44,8 @@   parseTag :: Text -> a   tagUNK :: a   tagTerm :: a -> Text-+  startTag :: a+  endTag :: a  -- | A fall-back 'ChunkTag' instance, analogous to 'RawTag' newtype RawChunk = RawChunk Text@@ -50,6 +55,8 @@  instance ChunkTag RawChunk where   fromChunk (RawChunk ch) = ch+  parseChunk txt = Right (RawChunk txt)+  notChunk = RawChunk "O"  -- | A fallback POS tag instance. newtype RawTag = RawTag Text@@ -67,6 +74,9 @@   tagUNK = RawTag "Unk"    tagTerm (RawTag t) = t++  startTag = RawTag "-START-"+  endTag = RawTag "-END-"  instance Arbitrary RawTag where   arbitrary = do

@@ -35,6 +35,17 @@ data ChunkedSentence chunk tag = ChunkedSent [ChunkOr chunk tag]   deriving (Read, Show, Eq) +-- | A data type to represent the portions of a parse tree for Chunks.+-- Note that this part of the parse tree could be a POS tag with no+-- chunk.+data ChunkOr chunk tag = Chunk_CN (Chunk chunk tag)+                       | POS_CN   (POS tag)+                         deriving (Read, Show, Eq)++-- | A Chunk that strictly contains chunks or POS tags.+data Chunk chunk tag = Chunk chunk [ChunkOr chunk tag]+  deriving (Read, Show, Eq)+ instance (ChunkTag c, Arbitrary c, Arbitrary t, Tag t) =>   Arbitrary (ChunkedSentence c t) where   arbitrary = ChunkedSent <$> arbitrary@@ -67,6 +78,20 @@       topair (POS tag tok) = (tag, tok)   in (Sent toks, tags) +unzipChunks :: (ChunkTag c, Tag t) => ChunkedSentence c t -> (TaggedSentence t, [c])+unzipChunks (ChunkedSent cs) = (TaggedSent poss, chunks)+  where+    (poss, chunks) = unzip (concatMap f cs)++--    f :: ChunkOr chunk tag -> [(POS tag, chunk)]+    f (POS_CN                  postag) = [(postag, notChunk)]+    f (Chunk_CN (Chunk chTag subTree)) = map (updateChunk chTag) (concatMap f subTree)++--    updateChunk :: c -> (POS t, c) -> (POS t, c)+    updateChunk chunk (ptag, oldChunk) | oldChunk == notChunk = (ptag, chunk)+                                       | otherwise            = (ptag, oldChunk)++ -- | Combine the results of POS taggers, using the second param to -- fill in 'tagUNK' entries, where possible. combine :: Tag t => [TaggedSentence t] -> [TaggedSentence t] -> [TaggedSentence t]@@ -85,12 +110,6 @@   | t1 /= tagUNK = POS t1 txt1   | otherwise    = POS t2 txt1 --- | A data type to represent the portions of a parse tree for Chunks.--- Note that this part of the parse tree could be a POS tag with no--- chunk.-data ChunkOr chunk tag = Chunk_CN (Chunk chunk tag)-                       | POS_CN   (POS tag)-                         deriving (Read, Show, Eq)  instance (ChunkTag c, Arbitrary c, Arbitrary t, Tag t) => Arbitrary (ChunkOr c t) where   arbitrary = elements =<< do@@ -106,23 +125,24 @@ mkChink :: (ChunkTag chunk, Tag tag) => tag -> Token -> ChunkOr chunk tag mkChink tag token      = POS_CN (POS tag token) --- | A Chunk that strictly contains chunks or POS tags.-data Chunk chunk tag = Chunk chunk [ChunkOr chunk tag]-  deriving (Read, Show, Eq)  instance (ChunkTag c, Arbitrary c, Arbitrary t, Tag t) => Arbitrary (Chunk c t) where   arbitrary = Chunk <$> arbitrary <*> arbitrary  -- | A POS-tagged token.-data POS tag = POS tag Token-  deriving (Read, Show, Eq)+data POS tag = POS { posTag :: tag+                   , posToken :: Token+                   } deriving (Read, Show, Eq)  instance (Arbitrary t, Tag t) => Arbitrary (POS t) where   arbitrary = POS <$> arbitrary <*> arbitrary  -- | Show the underlying text token only.-showPOS :: Tag tag => POS tag -> Text-showPOS (POS _ (Token txt)) = txt+showPOStok :: Tag tag => POS tag -> Text+showPOStok (POS _ (Token txt)) = txt++showPOStag :: Tag tag => POS tag -> Text+showPOStag = tagTerm . posTag  -- | Show the text and tag. printPOS :: Tag tag => POS tag -> Text

@@ -21,15 +21,21 @@ import qualified NLP.POS.UnambiguousTagger   as UT  import qualified NLP.Corpora.Brown as B+import qualified NLP.Corpora.Conll as C  import TestUtils  tests :: Test tests = buildTest $ do-  tagger <- defaultTagger :: IO (POSTagger B.Tag)+  brown <- brownTagger :: IO (POSTagger B.Tag)+  def <- defaultTagger :: IO (POSTagger C.Tag)   return $ testGroup "Integration Tests"         [ testGroup "Default Tagger" $-            map (genTest $ tagText tagger)+            map (genTest $ tagText def)+              [ ("Simple 1", "The dog jumped.", "The/DT dog/NN jumped/VBD ./.")+              ]+        , testGroup "Brown Tagger" $+            map (genTest $ tagText brown)               [ ("Simple 1", "The dog jumped.", "The/AT dog/NN jumped/VBD ./.")               ]         , testGroup "POS Serialization" $

@@ -22,6 +22,7 @@ import qualified Data.DefaultMapTests as DefMap import qualified IntegrationTests as IT import qualified NLP.Corpora.BrownTests as Brown+import qualified NLP.Corpora.ConllTests as Conll import qualified NLP.Extraction.ParsecTests as Parsec import qualified NLP.POS.AvgPerceptronTagger as APT import qualified NLP.POS.UnambiguousTaggerTests as UT@@ -29,6 +30,8 @@ import qualified NLP.POSTests as POS import qualified NLP.Similarity.VectorSimTests as Vec import qualified NLP.TypesTests as TypeTests+import qualified NLP.Types.IOBTests as IOB+import qualified NLP.Chunk.AvgPerceptronChunkerTests as APC  import Corpora @@ -51,12 +54,6 @@           , testGroup "miniCorpora2 - POSTagger train" $             map (trainAndTagTestVTrainer miniCorpora1)              [ ("the dog jumped .", "the/DT dog/NN jumped/VB ./.") ]-          -- , skip $ testGroup "brown CA01" $-          --   map (trainAndTagTestFileCorpus brownCA01)-          --    [ ("the dog jumped .", "the/at dog/nn jumped/Unk ./.") ]-          -- , skip $ testGroup "brown CA" $-          --   map (trainAndTagTestIO brownCA)-          --    [ ("the dog jumped .", "the/at dog/nn jumped/vbd ./.") ]           ]         , APT.tests         , Backoff.tests@@ -69,6 +66,9 @@         , Parsec.tests         , IT.tests         , Brown.tests+        , Conll.tests+        , IOB.tests+        , APC.tests         ]