chatter 0.2.0.1 → 0.3.0.0

raw patch · 25 files changed

+1298/−304 lines, 25 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• appsrc/Evaluate.hs +4/−2
• appsrc/Tagger.hs +4/−1
• appsrc/Trainer.hs +7/−0
• changelog.md +39/−0
• chatter.cabal +11/−2
• data/models/brown-train.model.gz too large to diff
• src/NLP/Corpora/Brown.hs +673/−0
• src/NLP/Corpora/Parsing.hs +9/−6
• src/NLP/Extraction/Examples/ParsecExamples.hs +30/−31
• src/NLP/Extraction/Parsec.hs +36/−25
• src/NLP/POS.hs +31/−45
• src/NLP/POS/AvgPerceptronTagger.hs +44/−42
• src/NLP/POS/LiteralTagger.hs +14/−19
• src/NLP/POS/UnambiguousTagger.hs +12/−12
• src/NLP/Tokenize/Chatter.hs +15/−0
• src/NLP/Types.hs +15/−50
• src/NLP/Types/General.hs +19/−0
• src/NLP/Types/Tags.hs +57/−0
• src/NLP/Types/Tree.hs +206/−0
• tests/src/BackoffTaggerTests.hs +5/−5
• tests/src/IntegrationTests.hs +7/−4
• tests/src/Main.hs +24/−13
• tests/src/NLP/Extraction/ParsecTests.hs +21/−32
• tests/src/NLP/POS/UnambiguousTaggerTests.hs +5/−5
• tests/src/NLP/POSTests.hs +10/−10

@@ -8,6 +8,8 @@  import NLP.Corpora.Parsing import NLP.POS (eval, loadTagger)+import NLP.Types (POSTagger, RawTag, unTS)+import qualified NLP.Corpora.Brown as B  main :: IO () main = do@@ -15,10 +17,10 @@   let modelFile = args!!0       corpora = tail args   putStrLn "Loading model..."-  tagger <- loadTagger modelFile+  tagger <- (loadTagger modelFile:: IO (POSTagger B.Tag))   putStrLn "...model loaded."   rawCorpus <- mapM T.readFile corpora   let taggedCorpora = map readPOS $ concatMap T.lines $ rawCorpus       result = eval tagger taggedCorpora   putStrLn ("Result: " ++ show result)-  putStrLn ("Tokens tagged: "++(show $ length $ concat taggedCorpora))+  putStrLn ("Tokens tagged: "++(show $ length $ concatMap unTS taggedCorpora))

@@ -7,13 +7,16 @@ import System.Environment (getArgs)  import NLP.POS (tagText, loadTagger)+import NLP.Types (RawTag, POSTagger) +import qualified NLP.Corpora.Brown as B+ main :: IO () main = do   args <- getArgs   let modelFile = args!!0       sentence  = args!!1   putStrLn "Loading model..."-  tagger <- loadTagger modelFile+  tagger <- (loadTagger modelFile:: IO (POSTagger B.Tag))   putStrLn "...model loaded."   T.putStrLn $ tagText tagger (T.pack sentence)

@@ -10,13 +10,20 @@ import qualified NLP.POS.UnambiguousTagger as UT import NLP.POS (saveTagger, train) import NLP.Corpora.Parsing+import NLP.Types (POSTagger, RawTag) +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

@@ -0,0 +1,39 @@+= 0.3.0.0 =++ - Changed the Sentence and TaggedSentence data types to be actual+   tree structures with real types at the respective+   layers. ChunkedSentence and ChunkOr were also added to facilitate+   phrase and clause chunking.++ - Added a POS Tag data type for Brown corpus tags, and a Chunk type for+   Chunks as well (in the Brown module, but that's probably not the best+   place, given that the chunks have nothing to do with the actual Brown+   corpus.)++ - Updated the Parsec Examples to use the typed tags/chunks.++ - Regenerated the defaultTager, it uses the Brown tags now instead of+   RawTag.++= 0.2.0.1 =++ - I realized immediately after the 0.2.0.0 release that I broke the+   defaultTagger by adding the protectTerms function to the+   LiteralTagger.  Things broke because (i) there are bugs in that+   functionality, which uses run-time assembled regexes, and (ii) the+   UnambiguousTagger used in the defaultTagger delegates to an instance+   of the LiteralTagger, which pulled in the (semi-broken) protectTerms+   function.  This has been fixed by replacing the tokenizer when the+   LiteralTagger is used as an UnambiguousTagger -- the later tager+   doesn't need the functionality, and it should never have been used+   there anyway.++ - Added a bevy of tests to cover the above fix.++ - Added tests (currently breaking) that exercise the broken bits of+   the protectTerms function.++= 0.2.0.0 =++ - Added support for expressing information extraciton patterns via Parsec.+ - Misc. bug fixes.

@@ -1,5 +1,5 @@ name:                chatter-version:             0.2.0.1+version:             0.3.0.0 synopsis:            A library of simple NLP algorithms. description:         chatter is a collection of simple Natural Language                      Processing algorithms.@@ -24,6 +24,7 @@ maintainer:          creswick@gmail.com Cabal-Version:       >=1.10 build-type:          Simple+Extra-Source-Files:  changelog.md  data-files:          ./data/models/README                      ./data/models/brown-train.model.gz@@ -44,8 +45,13 @@                      NLP.POS.LiteralTagger                      NLP.POS.UnambiguousTagger                      NLP.Types+                     NLP.Types.General+                     NLP.Types.Tags+                     NLP.Types.Tree+                     NLP.Tokenize.Chatter                      NLP.Corpora.Parsing                      NLP.Corpora.Email+                     NLP.Corpora.Brown                      NLP.Similarity.VectorSim                      NLP.Extraction.Parsec                      NLP.Extraction.Examples.ParsecExamples@@ -73,7 +79,10 @@                      regex-base,                      regex-tdfa >= 1.2.0,                      regex-tdfa-text,-                     array+                     array,+                     QuickCheck < 2.6,+                     quickcheck-instances+      ghc-options:      -Wall

file too large to diff

@@ -0,0 +1,673 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}+-- | The internal implementation of critical types in terms of the+-- Brown corpus.+module NLP.Corpora.Brown+ ( Tag(..)+ , Chunk(..)+ )+where++import Data.Serialize (Serialize)+import qualified Data.Text as T+import Data.Text (Text)+import Text.Read (readMaybe)+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 = C_NP -- ^ Noun Phrase.+           | C_VP -- ^ Verb Phrase.+           | C_PP -- ^ Prepositional Phrase.+           | C_CL -- ^ Clause.+  deriving (Read, Show, Ord, Eq, Generic, Enum)++instance Arbitrary Chunk where+  arbitrary = elements [C_NP ..]++instance Serialize Chunk++instance Serialize Tag++instance T.Tag Tag where+  fromTag = showBrownTag++  parseTag txt = case parseBrownTag txt of+                   Left  _ -> Unk+                   Right t -> t++  -- | Constant tag for "unknown"+  tagUNK = Unk++  tagTerm = showBrownTag++instance Arbitrary Tag where+  arbitrary = elements [Op_Paren ..]++parseBrownTag :: Text -> Either Error Tag+parseBrownTag "(" = Right Op_Paren+parseBrownTag ")" = Right Cl_Paren+parseBrownTag "*" = Right Negator+parseBrownTag "," = Right Comma+parseBrownTag "-" = Right Dash+parseBrownTag "." = Right Term+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+++-- | 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 = [ ("-", "_")+                 , ("+", "_pl_")+                 , ("*", "star")+                 , ("$", "dollar")+                 ]++reversePatterns :: [(Text, Text)]+reversePatterns = map (\(x,y) -> (y,x)) tagTxtPatterns++showBrownTag :: Tag -> Text+showBrownTag Op_Paren = "("+showBrownTag Cl_Paren = ")"+showBrownTag Negator = "*"+showBrownTag Comma = ","+showBrownTag Dash = "-"+showBrownTag Term = "."+showBrownTag Colon = ":"+showBrownTag 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++data Tag = Op_Paren -- ^ (+         | Cl_Paren -- ^ )+         | Negator -- ^ *, not n't+         | Comma -- ^ ,+         | Dash -- ^ -+         | Term -- ^ . Sentence Terminator+         | Colon -- ^ :+         | ABL -- ^ determiner/pronoun, pre-qualifier e.g.; quite such+               -- rather+         | ABN -- ^ determiner/pronoun, pre-quantifier e.g.; all half+               -- many nary+         | ABX -- ^ determiner/pronoun, double conjunction or+               -- pre-quantifier both+         | AP -- ^ determiner/pronoun, post-determiner many other next+              -- more last former little several enough most least+              -- only very few fewer past same Last latter less single+              -- plenty 'nough lesser certain various manye+              -- next-to-last particular final previous present nuf+         | APdollar -- ^ determiner/pronoun, post-determiner, genitive+                    -- e.g.; other's+         | AP_pl_AP -- ^ determiner/pronoun, post-determiner,+                    -- hyphenated pair e.g.; many-much+         | AT -- ^ article e.g.; the an no a every th' ever' ye+         | BE -- ^ verb "to be", infinitive or imperative e.g.; be+         | BED -- ^ verb "to be", past tense, 2nd person singular or+               -- all persons plural e.g.; were+         | BEDstar -- ^ verb "to be", past tense, 2nd person singular+                   -- or all persons plural, negated e.g.; weren't+         | BEDZ -- ^ verb "to be", past tense, 1st and 3rd person+                -- singular e.g.; was+         | BEDZstar -- ^ verb "to be", past tense, 1st and 3rd person+                    -- singular, negated e.g.; wasn't+         | BEG -- ^ verb "to be", present participle or gerund e.g.;+               -- being+         | BEM -- ^ verb "to be", present tense, 1st person singular+               -- e.g.; am+         | BEMstar -- ^ verb "to be", present tense, 1st person+                   -- singular, negated e.g.; ain't+         | BEN -- ^ verb "to be", past participle e.g.; been+         | BER -- ^ verb "to be", present tense, 2nd person singular+               -- or all persons plural e.g.; are art+         | BERstar -- ^ verb "to be", present tense, 2nd person+                   -- singular or all persons plural, negated e.g.;+                   -- aren't ain't+         | BEZ -- ^ verb "to be", present tense, 3rd person singular+               -- e.g.; is+         | BEZstar -- ^ verb "to be", present tense, 3rd person+                   -- singular, negated e.g.; isn't ain't+         | CC -- ^ conjunction, coordinating e.g.; and or but plus &+              -- either neither nor yet 'n' and/or minus an'+         | CD -- ^ numeral, cardinal e.g.; two one 1 four 2 1913 71 74+              -- 637 1937 8 five three million 87-31 29-5 seven 1,119+              -- fifty-three 7.5 billion hundred 125,000 1,700 60 100+              -- six ...+         | CDdollar -- ^ numeral, cardinal, genitive e.g.; 1960's+                    -- 1961's .404's+         | CS -- ^ conjunction, subordinating e.g.; that as after+              -- whether before while like because if since for than+              -- altho until so unless though providing once lest+              -- s'posin' till whereas whereupon supposing tho' albeit+              -- then so's 'fore+         | DO -- ^ verb "to do", uninflected present tense, infinitive+              -- or imperative e.g.; do dost+         | DOstar -- ^ verb "to do", uninflected present tense or+                  -- imperative, negated e.g.; don't+         | DO_pl_PPSS -- ^ verb "to do", past or present tense ++                      -- pronoun, personal, nominative, not 3rd person+                      -- singular e.g.; d'you+         | DOD -- ^ verb "to do", past tense e.g.; did done+         | DODstar -- ^ verb "to do", past tense, negated e.g.; didn't+         | DOZ -- ^ verb "to do", present tense, 3rd person singular+               -- e.g.; does+         | DOZstar -- ^ verb "to do", present tense, 3rd person+                   -- singular, negated e.g.; doesn't don't+         | DT -- ^ determiner/pronoun, singular e.g.; this each+              -- another that 'nother+         | DTdollar -- ^ determiner/pronoun, singular, genitive e.g.;+                    -- another's+         | DT_pl_BEZ -- ^ determiner/pronoun + verb "to be", present+                     -- tense, 3rd person singular e.g.; that's+         | DT_pl_MD -- ^ determiner/pronoun + modal auxillary e.g.;+                    -- that'll this'll+         | DTI -- ^ determiner/pronoun, singular or plural e.g.; any+               -- some+         | DTS -- ^ determiner/pronoun, plural e.g.; these those them+         | DTS_pl_BEZ -- ^ pronoun, plural + verb "to be", present+                      -- tense, 3rd person singular e.g.; them's+         | DTX -- ^ determiner, pronoun or double conjunction e.g.;+               -- neither either one+         | EX -- ^ existential there e.g.; there+         | EX_pl_BEZ -- ^ existential there + verb "to be", present+                     -- tense, 3rd person singular e.g.; there's+         | EX_pl_HVD -- ^ existential there + verb "to have", past+                     -- tense e.g.; there'd+         | EX_pl_HVZ -- ^ existential there + verb "to have", present+                     -- tense, 3rd person singular e.g.; there's+         | EX_pl_MD -- ^ existential there + modal auxillary e.g.;+                    -- there'll there'd+         | FW_star -- ^ foreign word: negator e.g.; pas non ne+         | FW_AT -- ^ foreign word: article e.g.; la le el un die der+                 -- ein keine eine das las les Il+         | FW_AT_pl_NN -- ^ foreign word: article + noun, singular,+                       -- common e.g.; l'orchestre l'identite l'arcade+                       -- l'ange l'assistance l'activite L'Universite+                       -- l'independance L'Union L'Unita l'osservatore+         | FW_AT_pl_NP -- ^ foreign word: article + noun, singular,+                       -- proper e.g.; L'Astree L'Imperiale+         | FW_BE -- ^ foreign word: verb "to be", infinitive or+                 -- imperative e.g.; sit+         | FW_BER -- ^ foreign word: verb "to be", present tense, 2nd+                  -- person singular or all persons plural e.g.; sind+                  -- sunt etes+         | FW_BEZ -- ^ foreign word: verb "to be", present tense, 3rd+                  -- person singular e.g.; ist est+         | FW_CC -- ^ foreign word: conjunction, coordinating e.g.; et+                 -- ma mais und aber och nec y+         | FW_CD -- ^ foreign word: numeral, cardinal e.g.; une cinq+                 -- deux sieben unam zwei+         | FW_CS -- ^ foreign word: conjunction, subordinating e.g.;+                 -- bevor quam ma+         | FW_DT -- ^ foreign word: determiner/pronoun, singular e.g.;+                 -- hoc+         | FW_DT_pl_BEZ -- ^ foreign word: determiner + verb "to be",+                        -- present tense, 3rd person singular e.g.;+                        -- c'est+         | FW_DTS -- ^ foreign word: determiner/pronoun, plural e.g.;+                  -- haec+         | FW_HV -- ^ foreign word: verb "to have", present tense, not+                 -- 3rd person singular e.g.; habe+         | FW_IN -- ^ foreign word: preposition e.g.; ad de en a par+                 -- con dans ex von auf super post sine sur sub avec+                 -- per inter sans pour pendant in di+         | FW_IN_pl_AT -- ^ foreign word: preposition + article e.g.;+                       -- della des du aux zur d'un del dell'+         | FW_IN_pl_NN -- ^ foreign word: preposition + noun,+                       -- singular, common e.g.; d'etat d'hotel+                       -- d'argent d'identite d'art+         | FW_IN_pl_NP -- ^ foreign word: preposition + noun,+                       -- singular, proper e.g.; d'Yquem d'Eiffel+         | FW_JJ -- ^ foreign word: adjective e.g.; avant Espagnol+                 -- sinfonica Siciliana Philharmonique grand publique+                 -- haute noire bouffe Douce meme humaine bel+                 -- serieuses royaux anticus presto Sovietskaya+                 -- Bayerische comique schwarzen ...+         | FW_JJR -- ^ foreign word: adjective, comparative e.g.;+                  -- fortiori+         | FW_JJT -- ^ foreign word: adjective, superlative e.g.;+                  -- optimo+         | FW_NN -- ^ foreign word: noun, singular, common e.g.;+                 -- ballet esprit ersatz mano chatte goutte sang+                 -- Fledermaus oud def kolkhoz roi troika canto boite+                 -- blutwurst carne muzyka bonheur monde piece force+                 -- ...+         | FW_NNdollar -- ^ foreign word: noun, singular, common,+                       -- genitive e.g.; corporis intellectus arte's+                       -- dei aeternitatis senioritatis curiae+                       -- patronne's chambre's+         | FW_NNS -- ^ foreign word: noun, plural, common e.g.; al+                  -- culpas vopos boites haflis kolkhozes augen+                  -- tyrannis alpha-beta-gammas metis banditos rata+                  -- phis negociants crus Einsatzkommandos kamikaze+                  -- wohaws sabinas zorrillas palazzi engages coureurs+                  -- corroborees yori Ubermenschen ...+         | FW_NP -- ^ foreign word: noun, singular, proper e.g.;+                 -- Karshilama Dieu Rundfunk Afrique Espanol Afrika+                 -- Spagna Gott Carthago deus+         | FW_NPS -- ^ foreign word: noun, plural, proper e.g.;+                  -- Svenskarna Atlantes Dieux+         | FW_NR -- ^ foreign word: noun, singular, adverbial e.g.;+                 -- heute morgen aujourd'hui hoy+         | FW_OD -- ^ foreign word: numeral, ordinal e.g.; 18e 17e+                 -- quintus+         | FW_PN -- ^ foreign word: pronoun, nominal e.g.; hoc+         | FW_PPdollar -- ^ foreign word: determiner, possessive e.g.;+                       -- mea mon deras vos+         | FW_PPL -- ^ foreign word: pronoun, singular, reflexive+                  -- e.g.; se+         | FW_PPL_pl_VBZ -- ^ foreign word: pronoun, singular,+                         -- reflexive + verb, present tense, 3rd+                         -- person singular e.g.; s'excuse s'accuse+         | FW_PPO -- ^ pronoun, personal, accusative e.g.; lui me moi+                  -- mi+         | FW_PPO_pl_IN -- ^ foreign word: pronoun, personal,+                        -- accusative + preposition e.g.; mecum tecum+         | FW_PPS -- ^ foreign word: pronoun, personal, nominative,+                  -- 3rd person singular e.g.; il+         | FW_PPSS -- ^ foreign word: pronoun, personal, nominative,+                   -- not 3rd person singular e.g.; ich vous sie je+         | FW_PPSS_pl_HV -- ^ foreign word: pronoun, personal,+                         -- nominative, not 3rd person singular + verb+                         -- "to have", present tense, not 3rd person+                         -- singular e.g.; j'ai+         | FW_QL -- ^ foreign word: qualifier e.g.; minus+         | FW_RB -- ^ foreign word: adverb e.g.; bas assai deja um+                 -- wiederum cito velociter vielleicht simpliciter non+                 -- zu domi nuper sic forsan olim oui semper tout+                 -- despues hors+         | FW_RB_pl_CC -- ^ foreign word: adverb + conjunction,+                       -- coordinating e.g.; forisque+         | FW_TO_pl_VB -- ^ foreign word: infinitival to + verb,+                       -- infinitive e.g.; d'entretenir+         | FW_UH -- ^ foreign word: interjection e.g.; sayonara bien+                 -- adieu arigato bonjour adios bueno tchalo ciao o+         | FW_VB -- ^ foreign word: verb, present tense, not 3rd+                 -- person singular, imperative or infinitive e.g.;+                 -- nolo contendere vive fermate faciunt esse vade+                 -- noli tangere dites duces meminisse iuvabit+                 -- gosaimasu voulez habla ksu'u'peli'afo lacheln+                 -- miuchi say allons strafe portant+         | FW_VBD -- ^ foreign word: verb, past tense e.g.; stabat+                  -- peccavi audivi+         | FW_VBG -- ^ foreign word: verb, present participle or+                  -- gerund e.g.; nolens volens appellant+                  -- seq. obliterans servanda dicendi delenda+         | FW_VBN -- ^ foreign word: verb, past participle e.g.; vue+                  -- verstrichen rasa verboten engages+         | FW_VBZ -- ^ foreign word: verb, present tense, 3rd person+                  -- singular e.g.; gouverne sinkt sigue diapiace+         | FW_WDT -- ^ foreign word: WH-determiner e.g.; quo qua quod+                  -- que quok+         | FW_WPO -- ^ foreign word: WH-pronoun, accusative e.g.;+                  -- quibusdam+         | FW_WPS -- ^ foreign word: WH-pronoun, nominative e.g.; qui+         | HV -- ^ verb "to have", uninflected present tense,+              -- infinitive or imperative e.g.; have hast+         | HVstar -- ^ verb "to have", uninflected present tense or+                  -- imperative, negated e.g.; haven't ain't+         | HV_pl_TO -- ^ verb "to have", uninflected present tense ++                    -- infinitival to e.g.; hafta+         | HVD -- ^ verb "to have", past tense e.g.; had+         | HVDstar -- ^ verb "to have", past tense, negated e.g.;+                   -- hadn't+         | HVG -- ^ verb "to have", present participle or gerund e.g.;+               -- having+         | HVN -- ^ verb "to have", past participle e.g.; had+         | HVZ -- ^ verb "to have", present tense, 3rd person singular+               -- e.g.; has hath+         | HVZstar -- ^ verb "to have", present tense, 3rd person+                   -- singular, negated e.g.; hasn't ain't+         | IN -- ^ preposition e.g.; of in for by considering to on+              -- among at through with under into regarding than since+              -- despite according per before toward against as after+              -- during including between without except upon out over+              -- ...+         | IN_pl_IN -- ^ preposition, hyphenated pair e.g.; f'ovuh+         | IN_pl_PPO -- ^ preposition + pronoun, personal, accusative+                     -- e.g.; t'hi-im+         | JJ -- ^ adjective e.g.; recent over-all possible+              -- hard-fought favorable hard meager fit such widespread+              -- outmoded inadequate ambiguous grand clerical+              -- effective orderly federal foster general+              -- proportionate ...+         | JJdollar -- ^ adjective, genitive e.g.; Great's+         | JJ_pl_JJ -- ^ adjective, hyphenated pair e.g.; big-large+                    -- long-far+         | JJR -- ^ adjective, comparative e.g.; greater older further+               -- earlier later freer franker wider better deeper+               -- firmer tougher faster higher bigger worse younger+               -- lighter nicer slower happier frothier Greater newer+               -- Elder ...+         | JJR_pl_CS -- ^ adjective + conjunction, coordinating e.g.;+                     -- lighter'n+         | JJS -- ^ adjective, semantically superlative e.g.; top+               -- chief principal northernmost master key head main+               -- tops utmost innermost foremost uppermost paramount+               -- topmost+         | JJT -- ^ adjective, superlative e.g.; best largest coolest+               -- calmest latest greatest earliest simplest strongest+               -- newest fiercest unhappiest worst youngest worthiest+               -- fastest hottest fittest lowest finest smallest+               -- staunchest ...+         | MD -- ^ modal auxillary e.g.; should may might will would+              -- must can could shall ought need wilt+         | MDstar -- ^ modal auxillary, negated e.g.; cannot couldn't+                  -- wouldn't can't won't shouldn't shan't mustn't+                  -- musn't+         | MD_pl_HV -- ^ modal auxillary + verb "to have", uninflected+                    -- form e.g.; shouldda musta coulda must've woulda+                    -- could've+         | MD_pl_PPSS -- ^ modal auxillary + pronoun, personal,+                      -- nominative, not 3rd person singular e.g.;+                      -- willya+         | MD_pl_TO -- ^ modal auxillary + infinitival to e.g.; oughta+         | NN -- ^ noun, singular, common e.g.; failure burden court+              -- fire appointment awarding compensation Mayor interim+              -- committee fact effect airport management surveillance+              -- jail doctor intern extern night weekend duty+              -- legislation Tax Office ...+         | NNdollar -- ^ noun, singular, common, genitive e.g.;+                    -- season's world's player's night's chapter's+                    -- golf's football's baseball's club's U.'s+                    -- coach's bride's bridegroom's board's county's+                    -- firm's company's superintendent's mob's Navy's+                    -- ...+         | NN_pl_BEZ -- ^ noun, singular, common + verb "to be",+                     -- present tense, 3rd person singular e.g.;+                     -- water's camera's sky's kid's Pa's heat's+                     -- throat's father's money's undersecretary's+                     -- granite's level's wife's fat's Knife's fire's+                     -- name's hell's leg's sun's roulette's cane's+                     -- guy's kind's baseball's ...+         | NN_pl_HVD -- ^ noun, singular, common + verb "to have",+                     -- past tense e.g.; Pa'd+         | NN_pl_HVZ -- ^ noun, singular, common + verb "to have",+                     -- present tense, 3rd person singular e.g.; guy's+                     -- Knife's boat's summer's rain's company's+         | NN_pl_IN -- ^ noun, singular, common + preposition e.g.;+                    -- buncha+         | NN_pl_MD -- ^ noun, singular, common + modal auxillary+                    -- e.g.; cowhand'd sun'll+         | NN_pl_NN -- ^ noun, singular, common, hyphenated pair e.g.;+                    -- stomach-belly+         | NNS -- ^ noun, plural, common e.g.; irregularities+               -- presentments thanks reports voters laws legislators+               -- years areas adjustments chambers $100 bonds courts+               -- sales details raises sessions members congressmen+               -- votes polls calls ...+         | NNSdollar -- ^ noun, plural, common, genitive e.g.;+                     -- taxpayers' children's members' States' women's+                     -- cutters' motorists' steelmakers' hours'+                     -- Nations' lawyers' prisoners' architects'+                     -- tourists' Employers' secretaries' Rogues' ...+         | NNS_pl_MD -- ^ noun, plural, common + modal auxillary e.g.;+                     -- duds'd oystchers'll+         | NP -- ^ noun, singular, proper e.g.; Fulton Atlanta+              -- September-October Durwood Pye Ivan Allen+              -- Jr. Jan. Alpharetta Grady William B. Hartsfield Pearl+              -- Williams Aug. Berry J. M. Cheshire Griffin Opelika+              -- Ala. E. Pelham Snodgrass ...+         | NPdollar -- ^ noun, singular, proper, genitive e.g.;+                    -- Green's Landis' Smith's Carreon's Allison's+                    -- Boston's Spahn's Willie's Mickey's Milwaukee's+                    -- Mays' Howsam's Mantle's Shaw's Wagner's+                    -- Rickey's Shea's Palmer's Arnold's Broglio's ...+         | NP_pl_BEZ -- ^ noun, singular, proper + verb "to be",+                     -- present tense, 3rd person singular e.g.; W.'s+                     -- Ike's Mack's Jack's Kate's Katharine's Black's+                     -- Arthur's Seaton's Buckhorn's Breed's Penny's+                     -- Rob's Kitty's Blackwell's Myra's Wally's+                     -- Lucille's Springfield's Arlene's+         | NP_pl_HVZ -- ^ noun, singular, proper + verb "to have",+                     -- present tense, 3rd person singular e.g.;+                     -- Bill's Guardino's Celie's Skolman's Crosson's+                     -- Tim's Wally's+         | NP_pl_MD -- ^ noun, singular, proper + modal auxillary+                    -- e.g.; Gyp'll John'll+         | NPS -- ^ noun, plural, proper e.g.; Chases Aderholds+               -- Chapelles Armisteads Lockies Carbones French+               -- Marskmen Toppers Franciscans Romans Cadillacs Masons+               -- Blacks Catholics British Dixiecrats Mississippians+               -- Congresses ...+         | NPSdollar -- ^ noun, plural, proper, genitive e.g.;+                     -- Republicans' Orioles' Birds' Yanks' Redbirds'+                     -- Bucs' Yankees' Stevenses' Geraghtys' Burkes'+                     -- Wackers' Achaeans' Dresbachs' Russians'+                     -- Democrats' Gershwins' Adventists' Negroes'+                     -- Catholics' ...+         | NR -- ^ noun, singular, adverbial e.g.; Friday home+              -- Wednesday Tuesday Monday Sunday Thursday yesterday+              -- tomorrow tonight West East Saturday west left east+              -- downtown north northeast southeast northwest North+              -- South right ...+         | NRdollar -- ^ noun, singular, adverbial, genitive e.g.;+                    -- Saturday's Monday's yesterday's tonight's+                    -- tomorrow's Sunday's Wednesday's Friday's+                    -- today's Tuesday's West's Today's South's+         | NR_pl_MD -- ^ noun, singular, adverbial + modal auxillary+                    -- e.g.; today'll+         | NRS -- ^ noun, plural, adverbial e.g.; Sundays Mondays+               -- Saturdays Wednesdays Souths Fridays+         | OD -- ^ numeral, ordinal e.g.; first 13th third nineteenth+              -- 2d 61st second sixth eighth ninth twenty-first+              -- eleventh 50th eighteenth- Thirty-ninth 72nd 1/20th+              -- twentieth mid-19th thousandth 350th sixteenth 701st+              -- ...+         | PN -- ^ pronoun, nominal e.g.; none something everything+              -- one anyone nothing nobody everybody everyone anybody+              -- anything someone no-one nothin+         | PNdollar -- ^ pronoun, nominal, genitive e.g.; one's+                    -- someone's anybody's nobody's everybody's+                    -- anyone's everyone's+         | PN_pl_BEZ -- ^ pronoun, nominal + verb "to be", present+                     -- tense, 3rd person singular e.g.; nothing's+                     -- everything's somebody's nobody's someone's+         | PN_pl_HVD -- ^ pronoun, nominal + verb "to have", past+                     -- tense e.g.; nobody'd+         | PN_pl_HVZ -- ^ pronoun, nominal + verb "to have", present+                     -- tense, 3rd person singular e.g.; nobody's+                     -- somebody's one's+         | PN_pl_MD -- ^ pronoun, nominal + modal auxillary e.g.;+                    -- someone'll somebody'll anybody'd+         | PPdollar -- ^ determiner, possessive e.g.; our its his+                    -- their my your her out thy mine thine+         | PPdollardollar -- ^ pronoun, possessive e.g.; ours mine his+                          -- hers theirs yours+         | PPL -- ^ pronoun, singular, reflexive e.g.; itself himself+               -- myself yourself herself oneself ownself+         | PPLS -- ^ pronoun, plural, reflexive e.g.; themselves+                -- ourselves yourselves+         | PPO -- ^ pronoun, personal, accusative e.g.; them it him me+               -- us you 'em her thee we'uns+         | PPS -- ^ pronoun, personal, nominative, 3rd person singular+               -- e.g.; it he she thee+         | PPS_pl_BEZ -- ^ pronoun, personal, nominative, 3rd person+                      -- singular + verb "to be", present tense, 3rd+                      -- person singular e.g.; it's he's she's+         | PPS_pl_HVD -- ^ pronoun, personal, nominative, 3rd person+                      -- singular + verb "to have", past tense e.g.;+                      -- she'd he'd it'd+         | PPS_pl_HVZ -- ^ pronoun, personal, nominative, 3rd person+                      -- singular + verb "to have", present tense, 3rd+                      -- person singular e.g.; it's he's she's+         | PPS_pl_MD -- ^ pronoun, personal, nominative, 3rd person+                     -- singular + modal auxillary e.g.; he'll she'll+                     -- it'll he'd it'd she'd+         | PPSS -- ^ pronoun, personal, nominative, not 3rd person+                -- singular e.g.; they we I you ye thou you'uns+         | PPSS_pl_BEM -- ^ pronoun, personal, nominative, not 3rd+                       -- person singular + verb "to be", present+                       -- tense, 1st person singular e.g.; I'm Ahm+         | PPSS_pl_BER -- ^ pronoun, personal, nominative, not 3rd+                       -- person singular + verb "to be", present+                       -- tense, 2nd person singular or all persons+                       -- plural e.g.; we're you're they're+         | PPSS_pl_BEZ -- ^ pronoun, personal, nominative, not 3rd+                       -- person singular + verb "to be", present+                       -- tense, 3rd person singular e.g.; you's+         | PPSS_pl_BEZstar -- ^ pronoun, personal, nominative, not 3rd+                           -- person singular + verb "to be", present+                           -- tense, 3rd person singular, negated+                           -- e.g.; 'tain't+         | PPSS_pl_HV -- ^ pronoun, personal, nominative, not 3rd+                      -- person singular + verb "to have", uninflected+                      -- present tense e.g.; I've we've they've you've+         | PPSS_pl_HVD -- ^ pronoun, personal, nominative, not 3rd+                       -- person singular + verb "to have", past tense+                       -- e.g.; I'd you'd we'd they'd+         | PPSS_pl_MD -- ^ pronoun, personal, nominative, not 3rd+                      -- person singular + modal auxillary e.g.;+                      -- you'll we'll I'll we'd I'd they'll they'd+                      -- you'd+         | PPSS_pl_VB -- ^ pronoun, personal, nominative, not 3rd+                      -- person singular + verb "to verb", uninflected+                      -- present tense e.g.; y'know+         | QL -- ^ qualifier, pre e.g.; well less very most so real as+              -- highly fundamentally even how much remarkably+              -- somewhat more completely too thus ill deeply little+              -- overly halfway almost impossibly far severly such ...+         | QLP -- ^ qualifier, post e.g.; indeed enough still 'nuff+         | RB -- ^ adverb e.g.; only often generally also nevertheless+              -- upon together back newly no likely meanwhile near+              -- then heavily there apparently yet outright fully+              -- aside consistently specifically formally ever just+              -- ...+         | RBdollar -- ^ adverb, genitive e.g.; else's+         | RB_pl_BEZ -- ^ adverb + verb "to be", present tense, 3rd+                     -- person singular e.g.; here's there's+         | RB_pl_CS -- ^ adverb + conjunction, coordinating e.g.;+                    -- well's soon's+         | RBR -- ^ adverb, comparative e.g.; further earlier better+               -- later higher tougher more harder longer sooner less+               -- faster easier louder farther oftener nearer cheaper+               -- slower tighter lower worse heavier quicker ...+         | RBR_pl_CS -- ^ adverb, comparative + conjunction,+                     -- coordinating e.g.; more'n+         | RBT -- ^ adverb, superlative e.g.; most best highest+               -- uppermost nearest brightest hardest fastest deepest+               -- farthest loudest ...+         | RN -- ^ adverb, nominal e.g.; here afar then+         | RP -- ^ adverb, particle e.g.; up out off down over on in+              -- about through across after+         | RP_pl_IN -- ^ adverb, particle + preposition e.g.; out'n+                    -- outta+         | TO -- ^ infinitival to e.g.; to t'+         | TO_pl_VB -- ^ infinitival to + verb, infinitive e.g.;+                    -- t'jawn t'lah+         | UH -- ^ interjection e.g.; Hurrah bang whee hmpf ah goodbye+              -- oops oh-the-pain-of-it ha crunch say oh why see well+              -- hello lo alas tarantara rum-tum-tum gosh hell keerist+              -- Jesus Keeeerist boy c'mon 'mon goddamn bah hoo-pig+              -- damn ...+         | VB -- ^ verb, base: uninflected present, imperative or+              -- infinitive e.g.; investigate find act follow inure+              -- achieve reduce take remedy re-set distribute realize+              -- disable feel receive continue place protect eliminate+              -- elaborate work permit run enter force ...+         | VB_pl_AT -- ^ verb, base: uninflected present or infinitive+                    -- + article e.g.; wanna+         | VB_pl_IN -- ^ verb, base: uninflected present, imperative+                    -- or infinitive + preposition e.g.; lookit+         | VB_pl_JJ -- ^ verb, base: uninflected present, imperative+                    -- or infinitive + adjective e.g.; die-dead+         | VB_pl_PPO -- ^ verb, uninflected present tense + pronoun,+                     -- personal, accusative e.g.; let's lemme gimme+         | VB_pl_RP -- ^ verb, imperative + adverbial particle e.g.;+                    -- g'ahn c'mon+         | VB_pl_TO -- ^ verb, base: uninflected present, imperative+                    -- or infinitive + infinitival to e.g.; wanta+                    -- wanna+         | VB_pl_VB -- ^ verb, base: uninflected present, imperative+                    -- or infinitive; hypenated pair e.g.; say-speak+         | VBD -- ^ verb, past tense e.g.; said produced took+               -- recommended commented urged found added praised+               -- charged listed became announced brought attended+               -- wanted voted defeated received got stood shot+               -- scheduled feared promised made ...+         | VBG -- ^ verb, present participle or gerund e.g.;+               -- modernizing improving purchasing Purchasing lacking+               -- enabling pricing keeping getting picking entering+               -- voting warning making strengthening setting+               -- neighboring attending participating moving ...+         | VBG_pl_TO -- ^ verb, present participle + infinitival to+                     -- e.g.; gonna+         | VBN -- ^ verb, past participle e.g.; conducted charged won+               -- received studied revised operated accepted combined+               -- experienced recommended effected granted seen+               -- protected adopted retarded notarized selected+               -- composed gotten printed ...+         | VBN_pl_TO -- ^ verb, past participle + infinitival to e.g.;+                     -- gotta+         | VBZ -- ^ verb, present tense, 3rd person singular e.g.;+               -- deserves believes receives takes goes expires says+               -- opposes starts permits expects thinks faces votes+               -- teaches holds calls fears spends collects backs+               -- eliminates sets flies gives seeks reads ...+         | WDT -- ^ WH-determiner e.g.; which what whatever whichever+               -- whichever-the-hell+         | WDT_pl_BER -- ^ WH-determiner + verb "to be", present+                      -- tense, 2nd person singular or all persons+                      -- plural e.g.; what're+         | WDT_pl_BER_pl_PP -- ^ WH-determiner + verb "to be",+                            -- present, 2nd person singular or all+                            -- persons plural + pronoun, personal,+                            -- nominative, not 3rd person singular+                            -- e.g.; whaddya+         | WDT_pl_BEZ -- ^ WH-determiner + verb "to be", present+                      -- tense, 3rd person singular e.g.; what's+         | WDT_pl_DO_pl_PPS -- ^ WH-determiner + verb "to do",+                            -- uninflected present tense + pronoun,+                            -- personal, nominative, not 3rd person+                            -- singular e.g.; whaddya+         | WDT_pl_DOD -- ^ WH-determiner + verb "to do", past tense+                      -- e.g.; what'd+         | WDT_pl_HVZ -- ^ WH-determiner + verb "to have", present+                      -- tense, 3rd person singular e.g.; what's+         | WPdollar -- ^ WH-pronoun, genitive e.g.; whose whosever+         | WPO -- ^ WH-pronoun, accusative e.g.; whom that who+         | WPS -- ^ WH-pronoun, nominative e.g.; that who whoever+               -- whosoever what whatsoever+         | WPS_pl_BEZ -- ^ WH-pronoun, nominative + verb "to be",+                      -- present, 3rd person singular e.g.; that's+                      -- who's+         | WPS_pl_HVD -- ^ WH-pronoun, nominative + verb "to have",+                      -- past tense e.g.; who'd+         | WPS_pl_HVZ -- ^ WH-pronoun, nominative + verb "to have",+                      -- present tense, 3rd person singular e.g.;+                      -- who's that's+         | WPS_pl_MD -- ^ WH-pronoun, nominative + modal auxillary+                     -- e.g.; who'll that'd who'd that'll+         | WQL -- ^ WH-qualifier e.g.; however how+         | WRB -- ^ WH-adverb e.g.; however when where why whereby+               -- wherever how whenever whereon wherein wherewith+               -- wheare wherefore whereof howsabout+         | WRB_pl_BER -- ^ WH-adverb + verb "to be", present, 2nd+                      -- person singular or all persons plural e.g.;+                      -- where're+         | WRB_pl_BEZ -- ^ WH-adverb + verb "to be", present, 3rd+                      -- person singular e.g.; how's where's+         | WRB_pl_DO -- ^ WH-adverb + verb "to do", present, not 3rd+                     -- person singular e.g.; howda+         | WRB_pl_DOD -- ^ WH-adverb + verb "to do", past tense e.g.;+                      -- where'd how'd+         | WRB_pl_DODstar -- ^ WH-adverb + verb "to do", past tense,+                          -- negated e.g.; whyn't+         | WRB_pl_DOZ -- ^ WH-adverb + verb "to do", present tense,+                      -- 3rd person singular e.g.; how's+         | 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)

@@ -4,7 +4,8 @@ import qualified Data.Text as T import Data.Text (Text) -import NLP.Types (Tag(..), parseTag, tagUNK, TaggedSentence)+import NLP.Types (Tag(..), parseTag, tagUNK, TaggedSentence(..)+                 , POS(..), Token(..))  -- | Read a POS-tagged corpus out of a Text string of the form: -- "token\/tag token\/tag..."@@ -12,14 +13,16 @@ -- >>> readPOS "Dear/jj Sirs/nns :/: Let/vb" -- [("Dear",JJ),("Sirs",NNS),(":",Other ":"),("Let",VB)] ---readPOS :: Text -> TaggedSentence-readPOS str = map toTagged $ T.words str+readPOS :: Tag t => Text -> TaggedSentence t+readPOS str = readPOSWith parseTag str++readPOSWith :: Tag t => (Text -> t) -> Text -> TaggedSentence t+readPOSWith parser str = TaggedSent $ map toTagged $ T.words str     where-      toTagged :: Text -> (Text, Tag)       toTagged txt | "/" `T.isInfixOf` txt = let           (tok, tagStr) = T.breakOnEnd "/" (T.strip txt)-          in (safeInit tok, parseTag tagStr)-                   | otherwise = (txt, tagUNK)+          in POS (parser tagStr) (Token $ safeInit tok)+                   | otherwise = POS tagUNK (Token txt)  -- | Returns all but the last element of a string, unless the string -- is empty, in which case it returns that string.

@@ -2,15 +2,15 @@ module NLP.Extraction.Examples.ParsecExamples where  import qualified Data.Text as T-import Data.Text (Text) -import Text.Parsec.Prim (parse, (<|>), try)-import Text.Parsec.Pos+import Text.Parsec.Prim ( (<|>), try) import qualified Text.Parsec.Combinator as PC  import NLP.Types import NLP.Extraction.Parsec +import qualified NLP.Corpora.Brown as B+ -- grammar = r""" --   NP: {<DT|JJ|NN.*>+}          # Chunk sequences of DT, JJ, NN --   PP: {<IN><NP>}               # Chunk prepositions followed by NP@@ -18,42 +18,41 @@ --   CLAUSE: {<NP><VP>}           # Chunk NP, VP --   """ -- cp = nltk.RegexpParser(grammar)--- sentence = [("Mary", "NN"), ("saw", "VBD"), ("the", "DT"), ("cat", "NN"),---     ("sit", "VB"), ("on", "IN"), ("the", "DT"), ("mat", "NN")]-+-- sentence = [("Mary", Tag "NN"), ("saw", Tag "VBD"), ("the", Tag "DT"), ("cat", Tag "NN"), ("sit", Tag "VB"), ("on", Tag "IN"), ("the", Tag "DT"), ("mat", Tag "NN")]+-- sentence = [TaggedSent [POS NP (Token "Mary"),POS VBD (Token "saw"),POS DT (Token "the"),POS NN (Token "cat"),POS VB (Token "sit"),POS IN (Token "on"),POS DT (Token "the"),POS NN (Token "mat"),POS Term (Token ".")]]+-- | Find a clause in a larger collection of text.+--+-- findClause skips over leading tokens, if needed, to locate a+-- clause.+findClause :: Extractor B.Tag (ChunkOr B.Chunk B.Tag)+findClause = followedBy anyToken clause --- | Create a chunked tag from a set of incomming tagged tokens.-chunk :: [(Text, Tag)] -- ^ The incomming tokens to create a chunk from.-      -> Tag           -- ^ The tag for the chunk.-      -> (Text, Tag)-chunk tss tg = (T.unwords (map fst tss), tg)+clause :: Extractor B.Tag (ChunkOr B.Chunk B.Tag)+clause = do+  np <- nounPhrase+  vp <- verbPhrase+  return $ mkChunk B.C_CL [np, vp] -prepPhrase :: Extractor (Text, Tag)+prepPhrase :: Extractor B.Tag (ChunkOr B.Chunk B.Tag) prepPhrase = do-  prep <- posTok $ Tag "IN"+  prep <- posTok B.IN   np <- nounPhrase-  return $ chunk [prep, np] (Tag "p-phr")+  return $ mkChunk B.C_PP [POS_CN prep, np] -nounPhrase :: Extractor (Text, Tag)+nounPhrase :: Extractor B.Tag (ChunkOr B.Chunk B.Tag) nounPhrase = do-  nlist <- PC.many1 (try (posTok $ Tag "NN")-              <|> try (posTok $ Tag "DT")-                  <|> (posTok $ Tag "JJ"))-  let term = T.intercalate " " (map fst nlist)-  return (term, Tag "n-phr")--clause :: Extractor (Text, Tag)-clause = do-  np <- nounPhrase-  vp <- verbPhrase-  return $ chunk [np, vp] $ Tag "clause"+  nlist <- PC.many1 (try (posTok $ B.NN)+              <|> try (posTok $ B.DT)+                      <|> try (posTok $ B.AT) -- tagger often gets 'the' wrong.+                              <|> (posTok $ B.JJ))+  return (mkChunk B.C_NP $ map POS_CN nlist)  --  VP: {<VB.*><NP|PP|CLAUSE>+$} # Chunk verbs and their arguments --  CLAUSE: {<NP><VP>}-verbPhrase :: Extractor (Text, Tag)+verbPhrase :: Extractor B.Tag (ChunkOr B.Chunk B.Tag) verbPhrase = do   vp <- posPrefix "V"-  obj <- PC.many1 $ ((try nounPhrase)-                  <|> (try prepPhrase)-                  <|> clause)-  return $ chunk (vp:obj) $ Tag "v-phr"+  obj <- PC.many1 $ ((try clause)+                  <|> (try nounPhrase)+                  <|> prepPhrase)+  return $ mkChunk B.C_VP $ ((POS_CN vp):obj)

@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}  -- | This is a very simple wrapper around Parsec for writing -- Information Extraction patterns.@@ -27,12 +29,21 @@ import Data.Text (Text) import qualified Data.Text as T import Text.Parsec.String () -- required for the `Stream [t] Identity t` instance.-import Text.Parsec.Prim (lookAhead, token, Parsec, try)+import Text.Parsec.Prim (lookAhead, token, Parsec, try, Stream(..)) import qualified Text.Parsec.Combinator as PC import Text.Parsec.Pos  (newPos) -import NLP.Types (TaggedSentence, Tag(..), CaseSensitive(..))+import NLP.Types (TaggedSentence(..), Tag(..), CaseSensitive(..),+                                POS(..), Token(..)) +instance (Monad m, Tag t) => Stream (TaggedSentence t) m (POS t) where+  uncons (TaggedSent ts) = do+    mRes <- uncons ts+    case mRes of+      Nothing           -> return $ Nothing+      Just (mTok, rest) -> return $ Just (mTok, TaggedSent rest)+  {-# INLINE uncons #-}+ -- | A Parsec parser. -- -- Example usage:@@ -42,15 +53,15 @@ -- > import Text.Parsec.Prim -- > parse myExtractor "interactive repl" someTaggedSentence -- @-type Extractor = Parsec TaggedSentence ()+type Extractor t = Parsec (TaggedSentence t) ()  -- | Consume a token with the given POS Tag-posTok :: Tag -> Extractor (Text, Tag)+posTok :: Tag t => t -> Extractor t (POS t) posTok tag = token showTok posFromTok testTok   where-    showTok (_,t)       = show t-    posFromTok (_,_)    = newPos "unknown" 0 0-    testTok tok@(_,t) = if tag == t then Just tok else Nothing+    showTok      = show+    posFromTok _ = newPos "unknown" 0 0+    testTok tok@(POS t _) = if tag == t then Just tok else Nothing  -- | Consume a token with the specified POS prefix. --@@ -58,37 +69,37 @@ -- > parse (posPrefix "n") "ghci" [("Bob", Tag "np")] -- Right [("Bob", Tag "np")] -- @-posPrefix :: Text -> Extractor (Text, Tag)+posPrefix :: Tag t => Text -> Extractor t (POS t) posPrefix str = token showTok posFromTok testTok   where-    showTok (_,t)       = show t-    posFromTok (_,_)    = newPos "unknown" 0 0-    testTok tok@(_,Tag t) = if str `T.isPrefixOf` t then Just tok else Nothing+    showTok = show+    posFromTok _  = newPos "unknown" 0 0+    testTok tok@(POS t _) = if str `T.isPrefixOf` (tagTerm t) then Just tok else Nothing  -- | Text equality matching with optional case sensitivity.-matches :: CaseSensitive -> Text -> Text -> Bool+matches :: CaseSensitive -> Token -> Token -> Bool matches Sensitive   x y = x == y-matches Insensitive x y = (T.toLower x) == (T.toLower y)+matches Insensitive (Token x) (Token y) = (T.toLower x) == (T.toLower y)  -- | Consume a token with the given lexical representation.-txtTok :: CaseSensitive -> Text -> Extractor (Text, Tag)+txtTok :: Tag t => CaseSensitive -> Token -> Extractor t (POS t) txtTok sensitive txt = token showTok posFromTok testTok   where-    showTok (t,_)     = show t-    posFromTok (_,_)  = newPos "unknown" 0 0-    testTok tok@(t,_) | matches sensitive txt t = Just tok-                      | otherwise               = Nothing+    showTok = show+    posFromTok _  = newPos "unknown" 0 0+    testTok tok@(POS _ t) | matches sensitive txt t = Just tok+                          | otherwise               = Nothing  -- | Consume any one non-empty token.-anyToken :: Extractor (Text, Tag)+anyToken :: Tag t => Extractor t (POS t) anyToken = token showTok posFromTok testTok   where-    showTok (txt,_)     = show txt-    posFromTok (_,_)    = newPos "unknown" 0 0-    testTok tok@(txt,_) | txt == "" = Nothing-                        | otherwise  = Just tok+    showTok = show+    posFromTok _ = newPos "unknown" 0 0+    testTok tok@(POS _ txt) | txt == "" = Nothing+                            | otherwise = Just tok -oneOf :: CaseSensitive -> [Text] -> Extractor (Text, Tag)+oneOf :: Tag t => CaseSensitive -> [Token] -> Extractor t (POS t) oneOf sensitive terms = PC.choice (map (\t -> try (txtTok sensitive t)) terms)  -- | Skips any number of fill tokens, ending with the end parser, and@@ -96,7 +107,7 @@ -- -- This is useful when you know what you're looking for and (for -- instance) don't care what comes first.-followedBy :: Extractor b -> Extractor a -> Extractor a+followedBy :: Tag t => Extractor t b -> Extractor t a -> Extractor t a followedBy fill end = do   _ <- PC.manyTill fill (lookAhead end)   end

@@ -13,7 +13,7 @@ -- people don't (yet!) use "Data.Text" by default, so there is a -- wrapper around 'tag' that packs and unpacks the 'String'.  This is -- innefficient, but it's just to get you started, and 'tagStr' can be--- very handy when you're debugging an tagger in ghci (or cabal repl).+-- very handy when you're debugging a tagger in ghci (or cabal repl). -- -- 'tag' exposes more details of the tokenization and tagging, since -- it returns a list of `TaggedSentence`s, but it doesn't print@@ -52,17 +52,20 @@  import           NLP.Corpora.Parsing         (readPOS) import           NLP.Tokenize.Text           (tokenize)-import           NLP.Types                   (POSTagger (..), Sentence,-                                              Tag (..), TaggedSentence,-                                              stripTags, tagUNK)+import           NLP.Types                   ( POSTagger(..), Sentence, POS(..)+                                             , combine, Tag (..), unTS, tsLength+                                             , TaggedSentence(..), stripTags+                                             , tagUNK, printTS)  import qualified NLP.POS.AvgPerceptronTagger as Avg import qualified NLP.POS.LiteralTagger       as LT import qualified NLP.POS.UnambiguousTagger   as UT +import qualified NLP.Corpora.Brown as B+ import           Paths_chatter -defaultTagger :: IO POSTagger+defaultTagger :: IO (POSTagger B.Tag) defaultTagger = do   dir <- getDataDir   loadTagger (dir </> "data" </> "models" </> "brown-train.model.gz")@@ -71,7 +74,8 @@ -- tagger packaged with Chatter should have an entry here.  By -- convention, the IDs use are the fully qualified module name of the -- tagger package.-taggerTable :: Map ByteString (ByteString -> Maybe POSTagger -> Either String POSTagger)+taggerTable :: Tag t => Map ByteString+               (ByteString -> Maybe (POSTagger t) -> Either String (POSTagger t)) taggerTable = Map.fromList   [ (LT.taggerID, LT.readTagger)   , (Avg.taggerID, Avg.readTagger)@@ -79,7 +83,7 @@   ]  -- | Store a `POSTager' to a file.-saveTagger :: POSTagger -> FilePath -> IO ()+saveTagger :: Tag t => POSTagger t -> FilePath -> IO () saveTagger tagger file = BS.writeFile file (serialize tagger)  -- | Load a tagger, using the interal `taggerTable`.  If you need to@@ -89,7 +93,7 @@ -- This function checks the filename to determine if the content -- should be decompressed.  If the file ends with ".gz", then we -- assume it is a gziped model.-loadTagger :: FilePath -> IO POSTagger+loadTagger :: Tag t => FilePath -> IO (POSTagger t) loadTagger file = do   content <- getContent file   case deserialize taggerTable content of@@ -100,7 +104,7 @@     getContent f | ".gz" `isSuffixOf` file = fmap (LBS.toStrict . decompress) $ LBS.readFile f                  | otherwise               = BS.readFile f -serialize :: POSTagger -> ByteString+serialize :: Tag t => POSTagger t -> ByteString serialize tagger =   let backoff = case posBackoff tagger of                   Nothing -> Nothing@@ -110,9 +114,11 @@             , backoff             ) -deserialize :: Map ByteString (ByteString -> Maybe POSTagger -> Either String POSTagger)+deserialize :: Tag t =>+               Map ByteString+                  (ByteString -> Maybe (POSTagger t) -> Either String (POSTagger t))             -> ByteString-            -> Either String POSTagger+            -> Either String (POSTagger t) deserialize table bs = do   (theID, theTgr, mBackoff) <- decode bs   backoff <- case mBackoff of@@ -124,33 +130,18 @@  -- | Tag a chunk of input text with part-of-speech tags, using the -- sentence splitter, tokenizer, and tagger contained in the 'POSTager'.-tag :: POSTagger -> Text -> [TaggedSentence]+tag :: Tag t => POSTagger t -> Text -> [TaggedSentence t] tag p txt = let sentences = (posSplitter p) txt                 tokens    = map (posTokenizer p) sentences             in tagTokens p tokens -tagTokens :: POSTagger -> [Sentence] -> [TaggedSentence]+tagTokens :: Tag t => POSTagger t -> [Sentence] -> [TaggedSentence t] tagTokens p tokens = let priority = (posTagger p) tokens                      in case posBackoff p of                           Nothing  -> priority                           Just tgr -> combine priority (tagTokens tgr tokens)  --- | Combine the results of POS taggers, using the second param to--- fill in 'tagUNK' entries, where possible.-combine :: [TaggedSentence] -> [TaggedSentence] -> [TaggedSentence]-combine xs ys = zipWith combineSentences xs ys--combineSentences :: TaggedSentence -> TaggedSentence -> TaggedSentence-combineSentences xs ys = zipWith pickTag xs ys---- | Returns the first param, unless it is tagged 'tagUNK'.--- Throws an error if the text does not match.-pickTag :: (Text, Tag) -> (Text, Tag) -> (Text, Tag)-pickTag a@(txt1, t1) b@(txt2, t2) | txt1 /= txt2 = error ("Text does not match: "++ show a ++ " " ++ show b)-                                  | t1 /= tagUNK = (txt1, t1)-                                  | otherwise    = (txt1, t2)- -- | Tag the tokens in a string. -- -- Returns a space-separated string of tokens, each token suffixed@@ -159,28 +150,23 @@ -- >>> tag tagger "the dog jumped ." -- "the/at dog/nn jumped/vbd ./." ---tagStr :: POSTagger -> String -> String+tagStr :: Tag t => POSTagger t -> String -> String tagStr tgr = T.unpack . tagText tgr . T.pack  -- | Text version of tagStr-tagText :: POSTagger -> Text -> Text-tagText tgr str = T.intercalate " " $ map toTaggedTok taggedSents-  where-    taggedSents = concat $ tag tgr str--    toTaggedTok :: (Text, Tag) -> Text-    toTaggedTok (tok, Tag c) = tok `T.append` (T.cons '/' c)+tagText :: Tag t => POSTagger t -> Text -> Text+tagText tgr txt = T.intercalate " " $ map printTS $ tag tgr txt  -- | Train a tagger on string input in the standard form for POS -- tagged corpora: -- -- > trainStr tagger "the/at dog/nn jumped/vbd ./." ---trainStr :: POSTagger -> String -> IO POSTagger+trainStr :: Tag t => POSTagger t -> String -> IO (POSTagger t) trainStr tgr = trainText tgr . T.pack  -- | The `Text` version of `trainStr`-trainText :: POSTagger -> Text -> IO POSTagger+trainText :: Tag t => POSTagger t -> Text -> IO (POSTagger t) trainText p exs = train p (map readPOS $ tokenize exs)  -- | Train a 'POSTagger' on a corpus of sentences.@@ -200,7 +186,7 @@ -- > let newTagger = APT.mkTagger APT.emptyPerceptron Nothing -- > posTgr <- train newTagger trainingExamples ---train :: POSTagger -> [TaggedSentence] -> IO POSTagger+train :: Tag t => POSTagger t -> [TaggedSentence t] -> IO (POSTagger t) train p exs = do   let     trainBackoff = case posBackoff p of@@ -220,13 +206,13 @@ -- -- > |tokens tagged correctly| / |all tokens| ---eval :: POSTagger -> [TaggedSentence] -> Double+eval :: Tag t => POSTagger t -> [TaggedSentence t] -> Double eval tgr oracle = let   sentences = map stripTags oracle   results = (posTagger tgr) sentences-  totalTokens = fromIntegral $ sum $ map length oracle+  totalTokens = fromIntegral $ sum $ map tsLength oracle -  isMatch :: (Text, Tag) -> (Text, Tag) -> Double-  isMatch (_, rTag) (_, oTag) | rTag == oTag = 1-                              | otherwise    = 0-  in (sum $ zipWith isMatch (concat results) (concat oracle)) / totalTokens+  isMatch :: Tag t => POS t -> POS t -> Double+  isMatch (POS rTag _) (POS oTag _) | rTag == oTag = 1+                                    | otherwise    = 0+  in (sum $ zipWith isMatch (concatMap unTS results) (concatMap unTS oracle)) / totalTokens

@@ -19,7 +19,7 @@   ) where -import NLP.Corpora.Parsing (readPOS)+import NLP.Corpora.Parsing (readPOSWith) import NLP.POS.AvgPerceptron ( Perceptron, Feature(..)                              , Class(..), predict, update                              , emptyPerceptron, averageWeights)@@ -37,14 +37,14 @@ import qualified Data.Text as T import qualified Data.Text.IO as T -import NLP.Tokenize.Text (tokenize)+import NLP.Tokenize.Chatter (tokenize) import NLP.FullStop (segment) import System.Random.Shuffle (shuffleM)  taggerID :: ByteString taggerID = pack "NLP.POS.AvgPerceptronTagger" -readTagger :: ByteString -> Maybe POSTagger -> Either String POSTagger+readTagger :: Tag t => ByteString -> Maybe (POSTagger t) -> Either String (POSTagger t) readTagger bs backoff = do   model <- decode bs   return $ mkTagger model backoff@@ -56,7 +56,7 @@ -- tokenizer, and Erik Kow's fullstop sentence segmenter -- (<http://hackage.haskell.org/package/fullstop>) as a sentence -- splitter.-mkTagger :: Perceptron -> Maybe POSTagger -> POSTagger+mkTagger :: Tag t => Perceptron -> Maybe (POSTagger t) -> POSTagger t mkTagger per mTgr = POSTagger { posTagger  = tag per                               , posTrainer = \exs -> do                                   newPer <- trainInt itterations per exs@@ -87,17 +87,17 @@ -- >>> tag tagger $ map T.words $ T.lines "Dear sir" -- "Dear/jj Sirs/nns :/: Let/vb" ---trainNew :: Text -> IO Perceptron-trainNew rawCorpus = train emptyPerceptron rawCorpus+trainNew :: Tag t => (Text -> t) -> Text -> IO Perceptron+trainNew parser rawCorpus = train parser emptyPerceptron rawCorpus  -- | Train a new 'Perceptron' on a corpus of files.-trainOnFiles :: [FilePath] -> IO Perceptron-trainOnFiles corpora = foldM step emptyPerceptron corpora+trainOnFiles :: Tag t => (Text -> t) -> [FilePath] -> IO Perceptron+trainOnFiles parser corpora = foldM step emptyPerceptron corpora   where     step :: Perceptron -> FilePath -> IO Perceptron     step per path = do       content <- T.readFile path-      train per content+      train parser per content  -- | Add training examples to a perceptron. --@@ -108,24 +108,25 @@ -- If you're using multiple input files, this can be useful to improve -- performance (by folding over the files).  For example, see `trainOnFiles` ---train :: Perceptron -- ^ The inital model.+train :: Tag t => (Text -> t) -- ^ The POS tag parser.+      -> Perceptron -- ^ The inital model.       -> Text       -- ^ Training data; formatted with one sentence                     -- per line, and standard POS tags after each                     -- space-delimeted token.       -> IO Perceptron-train per rawCorpus = do-  let corpora = map readPOS $ T.lines rawCorpus+train parse per rawCorpus = do+  let corpora = map (readPOSWith parse) $ T.lines rawCorpus   trainInt itterations per corpora  -- | start markers to ensure all features in context are valid, -- even for the first "real" tokens.-startToks :: [Text]-startToks = ["-START-", "-START2-"]+startToks :: [Token]+startToks = [Token "-START-", Token "-START2-"]  -- | end markers to ensure all features are valid, even for -- the last "real" tokens.-endToks :: [Text]-endToks = ["-END-", "-END2-"]+endToks :: [Token]+endToks = [Token "-END-", Token "-END2-"]  -- | Tag a document (represented as a list of 'Sentence's) with a -- trained 'Perceptron'@@ -154,22 +155,22 @@ -- >             prev = tag -- >     return tokens ---tag :: Perceptron -> [Sentence] -> [TaggedSentence]+tag :: Tag t => Perceptron -> [Sentence] -> [TaggedSentence t] tag per corpus = map (tagSentence per) corpus  -- | Tag a single sentence.-tagSentence :: Perceptron -> Sentence -> TaggedSentence+tagSentence :: Tag t => Perceptron -> Sentence -> TaggedSentence t tagSentence per sent = let -  tags = (map (Class . T.unpack) startToks) ++ map (predictPos per) features+  tags = (map tokenToClass startToks) ++ map (predictPos per) features    features = zipWith4 (getFeatures sent)              [0..]-             sent+             (tokens sent)              (tail tags)              tags -  in zip sent (map (\(Class c) ->Tag $ T.pack c) $ drop 2 tags)+  in applyTags sent (map (\(Class c) -> parseTag $ T.pack c) $ drop 2 tags)  -- | Train a model from sentences. --@@ -202,16 +203,19 @@ -- >                      open(save_loc, 'wb'), -1) -- >     return None ---trainInt :: Int -- ^ The number of times to iterate over the training+trainInt :: 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.-         -> [TaggedSentence] -- ^ The training data. (A list of @[(Text, Tag)]@'s)+         -> [TaggedSentence 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 unzip examples+trainInt itr per examples = trainCls itr per $ toClassLst $ map unzipTags examples+  -- where+  --   toSentPair (xs, ts) = (Sent $ map Token xs, ts) -toClassLst ::  [(Sentence, [Tag])] -> [(Sentence, [Class])]+toClassLst :: Tag t => [(Sentence, [t])] -> [(Sentence, [Class])] toClassLst tagged = map (\(x, y)->(x, map (Class . T.unpack . fromTag) y)) tagged  trainCls :: Int -> Perceptron -> [(Sentence, [Class])] -> IO Perceptron@@ -219,6 +223,8 @@   trainingSet <- shuffleM $ concat $ take itr $ repeat examples   return $ averageWeights $ foldl' trainSentence per trainingSet +tokenToClass :: Token -> Class+tokenToClass = Class . T.unpack . showTok  -- | Train on one sentence. --@@ -237,11 +243,11 @@ trainSentence :: Perceptron -> (Sentence, [Class]) -> Perceptron trainSentence per (sent, ts) = let -  tags = (map (Class . T.unpack) startToks) ++ ts ++ (map (Class . T.unpack) endToks)+  tags = (map tokenToClass startToks) ++ ts ++ (map tokenToClass endToks)    features = zipWith4 (getFeatures sent)                          [0..] -- index-                         sent  -- words+                         (tokens sent)  -- words                          (tail tags) -- prev1                          tags  -- prev2 @@ -285,9 +291,9 @@ -- >     add('i+2 word', context[i+2]) -- >     return features ---getFeatures :: [Text] -> Int -> Text -> Class -> Class -> Map Feature Int+getFeatures :: Sentence -> Int -> Token -> Class -> Class -> Map Feature Int getFeatures ctx idx word prev prev2 = let-  context = startToks ++ ctx ++ endToks+  context = startToks ++ tokens ctx ++ endToks    i = idx + length startToks @@ -301,25 +307,21 @@   features :: [[Text]]   features = [ ["bias", ""]              , ["i suffix", suffix word ]-             , ["i pref1", T.take 1 word ]+             , ["i pref1", T.take 1 $ showTok word ]              , ["i-1 tag", T.pack $ show prev ]              , ["i-2 tag", T.pack $ show prev2 ]              , ["i tag+i-2 tag", T.pack $ show prev, T.pack $ show prev2 ]-             , ["i word", context!!i ]-             , ["i-1 tag+i word", T.pack $ show prev, context!!i ]-             , ["i-1 word", context!!(i-1) ]-             , ["i-1 suffix", suffix (context!!(i-1)) ]-             , ["i-2 word", context!!(i-2) ]-             , ["i+1 word", context!!(i+1) ]-             , ["i+1 suffix", suffix (context!!(i+1)) ]-             , ["i+2 word", context!!(i+2) ]+             , ["i word",     showTok (context!!i) ]+             , ["i-1 tag+i word", T.pack $ show prev, showTok (context!!i) ]+             , ["i-1 word",   showTok (context!!(i-1)) ]+             , ["i-1 suffix",  suffix (context!!(i-1)) ]+             , ["i-2 word",   showTok (context!!(i-2)) ]+             , ["i+1 word",   showTok (context!!(i+1)) ]+             , ["i+1 suffix",  suffix (context!!(i+1)) ]+             , ["i+2 word",   showTok (context!!(i+2)) ]              ]   -- in trace ("getFeatures: "++show (ctx, idx, word, prev, prev2)) $   in foldl' add Map.empty features  mkFeature :: Text -> Feature mkFeature txt = Feat $ T.copy txt--suffix :: Text -> Text-suffix str | T.length str <= 3 = str-           | otherwise       = T.drop (T.length str - 3) str

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module NLP.POS.LiteralTagger     ( tag@@ -11,9 +10,6 @@     ) where --import GHC.Generics- import Control.Monad ((>=>)) import Data.Array import Data.ByteString (ByteString)@@ -21,22 +17,21 @@ import Data.Function (on) import Data.List (sortBy) import qualified Data.Map.Strict as Map-import Data.Serialize (Serialize, encode, decode)+import Data.Serialize (encode, decode) import Data.Map.Strict (Map) import Data.Text (Text) import qualified Data.Text as T--import NLP.Tokenize.Text (Tokenizer, EitherList(..), defaultTokenizer, run)+import NLP.Tokenize.Text (Tokenizer, EitherList(..), defaultTokenizer)+import NLP.Tokenize.Chatter (runTokenizer) import NLP.FullStop (segment)-import NLP.Types ( tagUNK, Sentence, TaggedSentence-                 , Tag, POSTagger(..), CaseSensitive(..))+import NLP.Types ( tagUNK, Sentence, TaggedSentence(..), POS(..), applyTags+                 , Tag, POSTagger(..), CaseSensitive(..), tokens, showTok) import Text.Regex.TDFA import Text.Regex.TDFA.Text (compile)  taggerID :: ByteString taggerID = pack "NLP.POS.LiteralTagger" -instance Serialize CaseSensitive  -- | Create a Literal Tagger using the specified back-off tagger as a -- fall-back, if one is specified.@@ -44,17 +39,17 @@ -- This uses a tokenizer adapted from the 'tokenize' package for a -- tokenizer, and Erik Kow's fullstop sentence segmenter as a sentence -- splitter.-mkTagger :: Map Text Tag -> CaseSensitive -> Maybe POSTagger -> POSTagger+mkTagger :: Tag t => Map Text t -> CaseSensitive -> Maybe (POSTagger t) -> POSTagger t mkTagger table sensitive mTgr = POSTagger   { posTagger  = tag (canonicalize table) sensitive   , posTrainer = \_ -> return $ mkTagger table sensitive mTgr   , posBackoff = mTgr-  , posTokenizer = run (protectTerms (Map.keys table) sensitive >=> defaultTokenizer)+  , posTokenizer = runTokenizer (protectTerms (Map.keys table) sensitive >=> defaultTokenizer)   , posSplitter = (map T.pack) . segment . T.unpack   , posSerialize = encode (table, sensitive)   , posID = taggerID   }-  where canonicalize :: Map Text Tag -> Map Text Tag+  where canonicalize :: Tag t => Map Text t -> Map Text t         canonicalize =           case sensitive of             Sensitive   -> id@@ -122,14 +117,14 @@  --       | True    = E [Right x]  --    where isUri u = any (`T.isPrefixOf` u) ["http://","ftp://","mailto:"] -tag :: Map Text Tag -> CaseSensitive -> [Sentence] -> [TaggedSentence]+tag :: Tag t => Map Text t -> CaseSensitive -> [Sentence] -> [TaggedSentence t] tag table sensitive ss = map (tagSentence table sensitive) ss -tagSentence :: Map Text Tag -> CaseSensitive -> Sentence -> TaggedSentence-tagSentence table sensitive toks = map findTag toks+tagSentence :: Tag t => Map Text t -> CaseSensitive -> Sentence -> TaggedSentence t+tagSentence table sensitive sent = applyTags sent (map findTag $ tokens sent)   where-    findTag :: Text -> (Text, Tag)-    findTag txt = (txt, Map.findWithDefault tagUNK (canonicalize txt) table)+--    findTag :: Tag t => Token -> t+    findTag txt = Map.findWithDefault tagUNK (canonicalize $ showTok txt) table      canonicalize :: Text -> Text     canonicalize =@@ -139,7 +134,7 @@  -- | deserialization for Literal Taggers.  The serialization logic is -- in the posSerialize record of the POSTagger created in mkTagger.-readTagger :: ByteString -> Maybe POSTagger -> Either String POSTagger+readTagger :: Tag t => ByteString -> Maybe (POSTagger t) -> Either String (POSTagger t) readTagger bs backoff = do   (model, sensitive) <- decode bs   return $ mkTagger model sensitive backoff

@@ -17,7 +17,7 @@ import Data.Serialize (encode, decode) import Data.Text (Text) -import NLP.Tokenize.Text (defaultTokenizer, run)+import NLP.Tokenize.Chatter (tokenize) import NLP.Types  import qualified NLP.POS.LiteralTagger as LT@@ -25,18 +25,18 @@ taggerID :: ByteString taggerID = pack "NLP.POS.UnambiguousTagger" -readTagger :: ByteString -> Maybe POSTagger -> Either String POSTagger+readTagger :: Tag t => ByteString -> Maybe (POSTagger t) -> Either String (POSTagger t) readTagger bs backoff = do   model <- decode bs   return $ mkTagger model backoff  -- | Create an unambiguous tagger, using the supplied 'Map' as a -- source of tags.-mkTagger :: Map Text Tag -> Maybe POSTagger -> POSTagger+mkTagger :: Tag t => Map Text t -> Maybe (POSTagger t) -> POSTagger t mkTagger table mTgr = let   litTagger = LT.mkTagger table LT.Sensitive mTgr -  trainer :: [TaggedSentence] -> IO POSTagger+--  trainer :: Tag t => [TaggedSentence t] -> IO (POSTagger t)   trainer exs = do     let newTable = train table exs     return $ mkTagger newTable mTgr@@ -44,23 +44,23 @@   in litTagger { posTrainer = trainer                , posSerialize = encode table                , posID = taggerID-               , posTokenizer = run defaultTokenizer+               , posTokenizer = tokenize                }  -- | Trainer method for unambiguous taggers.-train :: Map Text Tag -> [TaggedSentence] -> Map Text Tag+train :: Tag t => Map Text t -> [TaggedSentence t] -> Map Text t train table exs = let-  pairs :: [(Text, Tag)]-  pairs = concat exs -  trainOnPair :: Map Text Tag -> (Text, Tag) -> Map Text Tag-  trainOnPair t (txt, tag) = Map.alter (incorporate tag) txt t+--  pairs :: POS t+  pairs = concatMap unTS exs -  incorporate :: Tag -> Maybe Tag -> Maybe Tag+--  trainOnPair :: Map Text t -> POS t -> Map Text t+  trainOnPair t (POS tag (Token txt)) = Map.alter (incorporate tag) txt t++--  incorporate :: t -> Maybe t -> Maybe t   incorporate new Nothing                 = Just new   incorporate new (Just old) | new == old = Just old                              | otherwise  = Just tagUNK -- Forget the tag.    in foldl trainOnPair table pairs- 

@@ -0,0 +1,15 @@+module NLP.Tokenize.Chatter+  ( runTokenizer+  , tokenize+  )+where++import Data.Text (Text)+import NLP.Tokenize.Text (Tokenizer, defaultTokenizer, run)+import NLP.Types.Tree++tokenize :: Text -> Sentence+tokenize txt = runTokenizer defaultTokenizer txt++runTokenizer :: Tokenizer -> (Text -> Sentence)+runTokenizer tok txt = Sent $ map Token (run tok txt)

@@ -1,7 +1,11 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} module NLP.Types+ ( module NLP.Types+ , module NLP.Types.Tags+ , module NLP.Types.General+ , module NLP.Types.Tree+ ) where  import Control.DeepSeq (NFData)@@ -13,31 +17,15 @@ import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8, decodeUtf8)-import GHC.Generics -type Sentence = [Text]-type TaggedSentence = [(Text, Tag)]--flattenText :: TaggedSentence -> Text-flattenText ts = T.unwords $ map fst ts---- | True if the input sentence contains the given text token.  Does--- not do partial or approximate matching, and compares details in a--- fully case-sensitive manner.-contains :: TaggedSentence -> Text -> Bool-contains ts tok = tok `elem` map fst ts---- | True if the input sentence contains the given POS tag.--- Does not do partial matching (such as prefix matching)-containsTag :: TaggedSentence -> Tag -> Bool-containsTag ts tag = tag `elem` map snd ts+import GHC.Generics --- | Boolean type to indicate case sensitivity for textual--- comparisons.-data CaseSensitive = Sensitive | Insensitive-  deriving (Read, Show, Generic)+import NLP.Types.General+import NLP.Types.Tags+import NLP.Types.Tree +-- data Tag t => TaggedSentence t = TS [(Text, t)]+--   deriving (Eq, Ord, Read, Show)  -- | Part of Speech tagger, with back-off tagger. --@@ -72,10 +60,10 @@ -- etc.) Look at the source for `NLP.POS.taggerTable` and -- `NLP.POS.UnambiguousTagger.readTagger` for examples. ---data POSTagger = POSTagger-    { posTagger  :: [Sentence] -> [TaggedSentence] -- ^ The initial part-of-speech tagger.-    , posTrainer :: [TaggedSentence] -> IO POSTagger -- ^ Training function to train the immediate POS tagger.-    , posBackoff :: Maybe POSTagger    -- ^ A tagger to invoke on unknown tokens.+data POSTagger t = POSTagger+    { posTagger  :: [Sentence] -> [TaggedSentence t] -- ^ The initial part-of-speech tagger.+    , posTrainer :: [TaggedSentence t] -> IO (POSTagger t) -- ^ Training function to train the immediate POS tagger.+    , posBackoff :: Maybe (POSTagger t)   -- ^ A tagger to invoke on unknown tokens.     , posTokenizer :: Text -> Sentence -- ^ A tokenizer; (`Data.Text.words` will work.)     , posSplitter :: Text -> [Text] -- ^ A sentence splitter.  If your input is formatted as                                     -- one sentence per line, then use `Data.Text.lines`,@@ -87,29 +75,6 @@                           -- algorithm used for this POS Tagger.  This                           -- is used in deserialization     }---- | Remove the tags from a tagged sentence-stripTags :: TaggedSentence -> Sentence-stripTags = map fst--newtype Tag = Tag Text-  deriving (Ord, Eq, Read, Show, Generic)--instance Serialize Tag--fromTag :: Tag -> Text-fromTag (Tag t) = t--parseTag :: Text -> Tag-parseTag t = Tag t---- | Constant tag for "unknown"-tagUNK :: Tag-tagUNK = Tag "Unk"--instance Serialize Text where-  put txt = put $ encodeUtf8 txt-  get     = fmap decodeUtf8 get  -- | Document corpus. --

@@ -0,0 +1,19 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module NLP.Types.General+where++import Data.Serialize (Serialize, put, get)+import Data.Text (Text)+import GHC.Generics+++-- | Just a handy alias for Text+type Error = Text++-- | Boolean type to indicate case sensitivity for textual+-- comparisons.+data CaseSensitive = Sensitive | Insensitive+  deriving (Read, Show, Generic)++instance Serialize CaseSensitive

@@ -0,0 +1,57 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module NLP.Types.Tags+where++import Data.Serialize (Serialize, get, put)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8, decodeUtf8)+import GHC.Generics++import Test.QuickCheck (Arbitrary(..), NonEmptyList(..))+import Test.QuickCheck.Instances ()++class (Ord a, Eq a, Read a, Show a, Generic a, Serialize a) => ChunkTag a where+  fromChunk :: a -> Text++class (Ord a, Eq a, Read a, Show a, Generic a, Serialize a) => Tag a where+  fromTag :: a -> Text+  parseTag :: Text -> a+  tagUNK :: a+  tagTerm :: a -> Text++newtype RawChunk = RawChunk Text+  deriving (Ord, Eq, Read, Show, Generic)++instance Serialize RawChunk++instance ChunkTag RawChunk where+  fromChunk (RawChunk ch) = ch++newtype RawTag = RawTag Text+  deriving (Ord, Eq, Read, Show, Generic)++instance Serialize RawTag++-- | Tag instance for unknown tagsets.+instance Tag RawTag where+  fromTag (RawTag t) = t++  parseTag t = RawTag t++  -- | Constant tag for "unknown"+  tagUNK = RawTag "Unk"++  tagTerm (RawTag t) = t++instance Arbitrary RawTag where+  arbitrary = do+    NonEmpty str <- arbitrary+    return $ RawTag $ T.pack str++instance Serialize Text where+  put txt = put $ encodeUtf8 txt+  get     = fmap decodeUtf8 get+

@@ -0,0 +1,206 @@+{-# LANGUAGE OverloadedStrings #-}+module NLP.Types.Tree where++import Prelude hiding (print)+import Control.Applicative ((<$>), (<*>))+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T+import Data.List (intercalate)++import Test.QuickCheck (Arbitrary(..), listOf, elements, NonEmptyList(..))+import Test.QuickCheck.Instances ()++import NLP.Types.Tags+import NLP.Types.General+import qualified NLP.Corpora.Brown as B++-- | A sentence of tokens without tags.  Generated by the tokenizer.+-- (tokenizer :: Text -> Sentence)+data Sentence = Sent [Token]+  deriving (Read, Show, Eq)++instance Arbitrary Sentence where+  arbitrary = Sent <$> arbitrary++tokens :: Sentence -> [Token]+tokens (Sent ts) = ts++applyTags :: Tag t => Sentence -> [t] -> TaggedSentence t+applyTags (Sent ts) tags = TaggedSent $ zipWith POS tags ts++-- | A chunked sentence has POS tags and chunk tags. Generated by a+-- chunker.+--+-- (chunker :: (Chunk chunk, Tag tag) => TaggedSentence tag -> ChunkedSentence chunk tag)+data ChunkedSentence chunk tag = ChunkedSent [ChunkOr chunk tag]+  deriving (Read, Show, Eq)++instance (ChunkTag c, Arbitrary c, Arbitrary t, Tag t) => Arbitrary (ChunkedSentence c t) where+  arbitrary = ChunkedSent <$> arbitrary++-- | A tagged sentence has POS Tags.  Generated by a part-of-speech+-- tagger. (tagger :: Tag tag => Sentence -> TaggedSentence tag)+data TaggedSentence tag = TaggedSent [POS tag]+  deriving (Read, Show, Eq)++instance (Arbitrary t, Tag t) => Arbitrary (TaggedSentence t) where+  arbitrary = TaggedSent <$> arbitrary++-- | Generate a Text representation of a TaggedSentence in the common+-- tagged format, eg:+--+-- > "the/at dog/nn jumped/vbd ./."+--+printTS :: Tag t => TaggedSentence t -> Text+printTS (TaggedSent ts) = T.intercalate " " $ map printPOS ts++-- | Remove the tags from a tagged sentence+stripTags :: Tag t => TaggedSentence t -> Sentence+stripTags ts = fst $ unzipTags ts++-- | Extract the tags from a tagged sentence, returning a parallel+-- list of tags along with the underlying Sentence.+unzipTags :: Tag t => TaggedSentence t -> (Sentence, [t])+unzipTags (TaggedSent ts) =+  let (tags, toks) = unzip $ map topair ts+      topair (POS tag tok) = (tag, tok)+  in (Sent toks, tags)++-- | 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]+combine xs ys = zipWith combineSentences xs ys++combineSentences :: Tag t => TaggedSentence t -> TaggedSentence t -> TaggedSentence t+combineSentences (TaggedSent xs) (TaggedSent ys) = TaggedSent $ zipWith pickTag xs ys++-- | Returns the first param, unless it is tagged 'tagUNK'.+-- Throws an error if the text does not match.+pickTag :: Tag t => POS t -> POS t -> POS t+pickTag a@(POS t1 txt1) b@(POS t2 txt2)+  | txt1 /= txt2 = error ("Text does not match: "++ show a ++ " " ++ show b)+  | t1 /= tagUNK = POS t1 txt1+  | otherwise    = POS t2 txt1++-- | This type seem redundant, it just exists to support the+-- differences in TaggedSentence and ChunkedSentence.+--+-- See the t3 example below to see how verbose this becomes.+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+                chunk <- mkChunk <$> arbitrary <*> listOf arbitrary+                chink <- mkChink <$> arbitrary <*> arbitrary+                return [chunk, chink]++mkChunk :: (ChunkTag chunk, Tag tag) => chunk -> [ChunkOr chunk tag] -> ChunkOr chunk tag+mkChunk chunk children = Chunk_CN (Chunk chunk children)++mkChink :: (ChunkTag chunk, Tag tag) => tag -> Token -> ChunkOr chunk tag+mkChink tag token      = POS_CN (POS tag token)+++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++data POS tag = POS tag 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++-- | Show the text and tag.+printPOS :: Tag tag => POS tag -> Text+printPOS (POS tag (Token txt)) = T.intercalate "" [txt, "/", tagTerm tag]++data Token = Token Text+  deriving (Read, Show, Eq)++instance Arbitrary Token where+  arbitrary = do NonEmpty txt <- arbitrary+                 return $ Token (T.pack txt)++instance IsString Token where+  fromString = Token . T.pack++showTok :: Token -> Text+showTok (Token txt) = txt++suffix :: Token -> Text+suffix (Token str) | T.length str <= 3 = str+                   | otherwise         = T.drop (T.length str - 3) str++unTS :: Tag t => TaggedSentence t -> [POS t]+unTS (TaggedSent ts) = ts++tsLength :: Tag t => TaggedSentence t -> Int+tsLength (TaggedSent ts) = length ts++tsConcat :: Tag t => [TaggedSentence t] -> TaggedSentence t+tsConcat tss = TaggedSent (concatMap unTS tss)++-- flattenText :: Tag t => TaggedSentence t -> Text+-- flattenText (TS ts) = T.unwords $ map fst ts++-- | True if the input sentence contains the given text token.  Does+-- not do partial or approximate matching, and compares details in a+-- fully case-sensitive manner.+contains :: Tag t => TaggedSentence t -> Text -> Bool+contains (TaggedSent ts) tok = any (posTokMatches tok) ts++-- | True if the input sentence contains the given POS tag.+-- Does not do partial matching (such as prefix matching)+containsTag :: Tag t => TaggedSentence t -> t -> Bool+containsTag (TaggedSent ts) tag = any (posTagMatches tag) ts++-- | Compare the POS-tag token with a supplied tag string.+posTagMatches :: Tag t => t -> POS t -> Bool+posTagMatches t1 (POS t2 _) = t1 == t2++-- | Compare the POS-tagged token with a text string.+posTokMatches :: Tag t => Text -> POS t -> Bool+posTokMatches txt (POS _ tok) = tokenMatches txt tok++-- | Compare a token with a text string.+tokenMatches :: Text -> Token -> Bool+tokenMatches txt (Token tok) = txt == tok++++-- (S (NP (NN I)) (VP (V saw) (NP (NN him))))+t1 :: Sentence+t1 = Sent+     [ Token "I"+     , Token "saw"+     , Token "him"+     , Token "."+     ]++t2 :: TaggedSentence B.Tag+t2 = TaggedSent+     [ POS B.NN    (Token "I")+     , POS B.VB    (Token "saw")+     , POS B.NN    (Token "him")+     , POS B.Term  (Token ".")+     ]++t3 :: ChunkedSentence B.Chunk B.Tag+t3 = ChunkedSent+     [ mkChunk B.C_NP [ mkChink B.NN (Token "I")  ]+     , mkChunk B.C_VP [ mkChink B.VB (Token "saw")+                      , mkChink B.NN (Token "him")+                      ]+     , mkChink B.Term (Token ".")+     ]+

@@ -19,15 +19,15 @@         [ testCase "Simple back-off tagging" testLiteralBackoff         ] -tagCat :: Map Text Tag-tagCat = Map.fromList [("cat", Tag "CAT")]+tagCat :: Map Text RawTag+tagCat = Map.fromList [("cat", RawTag "CAT")] -tagAnimals :: Map Text Tag-tagAnimals = Map.fromList [("cat", Tag "NN"), ("dog", Tag "NN")]+tagAnimals :: Map Text RawTag+tagAnimals = Map.fromList [("cat", RawTag "NN"), ("dog", RawTag "NN")]  testLiteralBackoff :: Assertion testLiteralBackoff = let   tgr = LT.mkTagger tagCat LT.Sensitive (Just $ LT.mkTagger tagAnimals LT.Sensitive Nothing)   actual = tag tgr "cat dog"-  oracle = [[("cat", Tag "CAT"), ("dog", Tag "NN")]]+  oracle = [TaggedSent [(POS (RawTag "CAT") "cat"), (POS (RawTag "NN") "dog")]]   in oracle @=? actual

@@ -29,15 +29,17 @@ import qualified NLP.POS.LiteralTagger       as LT import qualified NLP.POS.UnambiguousTagger   as UT +import qualified NLP.Corpora.Brown as B+ import TestUtils  tests :: Test tests = buildTest $ do-  tagger <- defaultTagger+  tagger <- defaultTagger :: IO (POSTagger B.Tag)   return $ testGroup "Integration Tests"         [ testGroup "Default Tagger" $             map (genTest $ tagText tagger)-              [ ("Simple 1", "The dog jumped.", "The/at dog/nn jumped/vbd ./.")+              [ ("Simple 1", "The dog jumped.", "The/AT dog/NN jumped/VBD ./.")               ]         , testGroup "POS Serialization" $             map (testSerialization examples)@@ -59,7 +61,7 @@  testSerialization :: [Text]  -- ^ A training corpus.  One sentence per entry.                   -> ( String    -- ^ The name of the POS tagger.-                     , POSTagger) -- ^ An empty (untrained) POS tagger.+                     , POSTagger B.Tag) -- ^ An empty (untrained) POS tagger.                   -> Test testSerialization training (name, newTagger) = testCase name doTest   where@@ -67,7 +69,8 @@     doTest = do       preTagger <- train newTagger $ map readPOS training -      let ePostTagger = deserialize taggerTable (serialize preTagger)+      let ePostTagger :: Either String (POSTagger B.Tag)+          ePostTagger = deserialize taggerTable (serialize preTagger)       case ePostTagger of         Left err -> assertFailure ("Tagger did not deserialize: "++err)         Right postTagger -> do

@@ -13,21 +13,22 @@ import Test.Framework ( buildTest, testGroup, Test, defaultMain ) -- import Test.Framework.Skip (skip) -import NLP.Types (Tag(..), parseTag)+import NLP.Types (Tag(..), parseTag, RawTag(..), POSTagger(..)) import NLP.POS (tagText, train) import NLP.Corpora.Parsing (readPOS) -import qualified NLP.POS.AvgPerceptronTagger as APT import qualified AvgPerceptronTests as APT import qualified BackoffTaggerTests as Backoff-import qualified NLP.Similarity.VectorSimTests as Vec-import qualified NLP.POSTests as POS+import qualified Data.DefaultMapTests as DefMap+import qualified IntegrationTests as IT+import qualified NLP.Corpora.BrownTests as Brown+import qualified NLP.Extraction.ParsecTests as Parsec+import qualified NLP.POS.AvgPerceptronTagger as APT import qualified NLP.POS.UnambiguousTaggerTests as UT import qualified NLP.POS.LiteralTaggerTests as LT+import qualified NLP.POSTests as POS+import qualified NLP.Similarity.VectorSimTests as Vec import qualified NLP.TypesTests as TypeTests-import qualified Data.DefaultMapTests as DefMap-import qualified NLP.Extraction.ParsecTests as Parsec-import qualified IntegrationTests as IT  import Corpora @@ -67,6 +68,7 @@         , DefMap.tests         , Parsec.tests         , IT.tests+        , Brown.tests         ]  @@ -77,24 +79,33 @@  trainAndTagTestIO :: IO Text -> (Text, Text) -> Test trainAndTagTestIO corpora (input, oracle) = testCase (T.unpack input) $ do-  tagger <- APT.trainNew =<< corpora-  oracle @=? tagText (APT.mkTagger tagger Nothing) input+  let parser :: Text -> RawTag+      parser = parseTag+  perceptron <- APT.trainNew parser =<< corpora+  let tagger :: POSTagger RawTag+      tagger = (APT.mkTagger perceptron Nothing)+  oracle @=? tagText tagger input  trainAndTagTest :: Text -> (Text, Text) -> Test trainAndTagTest corpora (input, oracle) = testCase (T.unpack input) $ do-  tagger <- APT.trainNew corpora-  oracle @=? tagText (APT.mkTagger tagger Nothing) input+  let parser :: Text -> RawTag+      parser = parseTag+  perceptron <- APT.trainNew parser corpora+  let tagger :: POSTagger RawTag+      tagger = (APT.mkTagger perceptron Nothing)+  oracle @=? tagText tagger input  trainAndTagTestVTrainer :: Text -> (Text, Text) -> Test trainAndTagTestVTrainer corpora (input, oracle) = testCase (T.unpack input) $ do-  let newTagger = APT.mkTagger APT.emptyPerceptron Nothing+  let newTagger :: POSTagger RawTag+      newTagger = APT.mkTagger APT.emptyPerceptron Nothing       examples = map readPOS $ T.lines corpora   posTgr <- train newTagger examples    oracle @=? tagText posTgr input  prop_parseTag :: Text -> Bool-prop_parseTag txt = parseTag txt == Tag txt+prop_parseTag txt = parseTag txt == RawTag txt  genTest :: (Show a, Show b, Eq b) => (a -> b) -> (String, a, b) -> Test genTest fn (descr, input, oracle) =

@@ -30,52 +30,41 @@         , testProperty "followedBy" prop_followedBy         , testGroup "Noun Phrase extractor" $             map (genTest parseNounPhrase)-             [ ("Just NN", [("Dog", Tag "NN")]-                         , Just ("Dog", Tag "n-phr"))-             , ("DT NN", [("The", Tag "DT"), ("dog", Tag "NN")]-                       , Just ("The dog", Tag "n-phr"))-             , ("NN NN", [("Sunday", Tag "NN"), ("night", Tag "NN")]-                       , Just ("Sunday night", Tag "n-phr"))-             , ("JJ NN", [("beautiful", Tag "JJ"), ("game", Tag "NN")]-                       , Just ("beautiful game", Tag "n-phr"))-             , ("None - VB", [("jump", Tag "VB")]+             [ ("Just NN", TaggedSent [(POS (RawTag "NN") "Dog")]+                         , Just (POS (RawTag "n-phr") "Dog"))+             , ("DT NN", TaggedSent [(POS (RawTag "DT") "The"), (POS (RawTag "NN") "dog")]+                       , Just (POS (RawTag "n-phr") "The dog"))+             , ("NN NN", TaggedSent [(POS (RawTag "NN") "Sunday"), (POS (RawTag "NN") "night")]+                       , Just (POS (RawTag "n-phr") "Sunday night"))+             , ("JJ NN", TaggedSent [(POS (RawTag "JJ") "beautiful"), (POS (RawTag "NN") "game")]+                       , Just (POS (RawTag "n-phr") "beautiful game"))+             , ("None - VB", TaggedSent [(POS (RawTag "VB") "jump")]                            , Nothing)              ]         ] -instance Arbitrary Tag where-  arbitrary = do-    NonEmpty str <- arbitrary-    return $ Tag $ T.pack str--instance Arbitrary TaggedSentence where-  arbitrary = listOf $ do-    NonEmpty tok <- arbitrary-    tag <- arbitrary-    return (T.pack tok, tag)--prop_posTok :: TaggedSentence -> Property-prop_posTok taggedSent = taggedSent /= [] ==>-  let (firstTok, firstTag) = head taggedSent+prop_posTok :: TaggedSentence RawTag -> Property+prop_posTok taggedSent = taggedSent /= TaggedSent [] ==>+  let (POS firstTag firstTok) = head (unTS taggedSent)       Right actual = parse (posTok firstTag) "prop_posTag" taggedSent-  in (firstTok, firstTag) == actual+  in (POS firstTag firstTok) == actual -prop_anyToken :: TaggedSentence -> Property-prop_anyToken taggedSent = taggedSent /= [] ==>+prop_anyToken :: TaggedSentence RawTag -> Property+prop_anyToken taggedSent = taggedSent /= TaggedSent [] ==>   let actual = parse anyToken "prop_anyToken" taggedSent   in isRight actual -prop_followedBy :: TaggedSentence -> Property-prop_followedBy taggedSent = taggedSent /= []+prop_followedBy :: TaggedSentence RawTag -> Property+prop_followedBy taggedSent = taggedSent /= TaggedSent []                           && not (contains taggedSent ".") ==>-  let (theToken, theTag) = (".", Tag ".")+  let (theToken, theTag) = (".", RawTag ".")       extractor          = followedBy anyToken $ txtTok Insensitive theToken       Right actual       = parse extractor "prop_followedBy"-                             (taggedSent ++ [(theToken, theTag)])-  in (theToken, theTag) == actual+                             (tsConcat [taggedSent, TaggedSent [POS theTag theToken]])+  in (POS theTag theToken) == actual  -parseNounPhrase :: TaggedSentence -> Maybe (Text, Tag)+parseNounPhrase :: TaggedSentence RawTag -> Maybe (POS RawTag) parseNounPhrase sent =   case parse nounPhrase "parseNounPhrase Test" sent of     Left  _ -> Nothing

@@ -32,17 +32,17 @@           ]         ] -emptyTagger :: POSTagger+emptyTagger :: POSTagger RawTag emptyTagger = UT.mkTagger Map.empty Nothing -trainedTagger :: POSTagger-trainedTagger = UT.mkTagger (Map.fromList [("the", Tag "dt"), ("dog", Tag "vb")]) Nothing+trainedTagger :: POSTagger RawTag+trainedTagger = UT.mkTagger (Map.fromList [("the", RawTag "dt"), ("dog", RawTag "vb")]) Nothing  prop_emptyAlwaysUnk :: String -> Bool-prop_emptyAlwaysUnk input = all (\(_, y) -> y == tagUNK) (concat $ tag emptyTagger inputTxt)+prop_emptyAlwaysUnk input = all (\(POS y _) -> y == tagUNK) (concatMap unTS $ tag emptyTagger inputTxt)   where inputTxt = T.pack input -trainAndTagTest :: POSTagger -> (Text, Text, Text) -> Test+trainAndTagTest :: Tag t => POSTagger t -> (Text, Text, Text) -> Test trainAndTagTest tgr (exs, input, oracle) = testCase (T.unpack (T.intercalate ": " [exs, input])) $ do   trained <- trainText tgr exs   oracle @=? tagText trained input

@@ -16,10 +16,10 @@ tests :: Test tests = testGroup "NLP.POS"         [ testGroup "Evaluation" $ map (genTestF $ eval mamalTagger)-             [ ("Half", [ [ ("the", Tag "DT"), ("cat", Tag "NN")]-                        , [ ("the", Tag "DT"), ("dog", Tag "NN")] ], 0.5)-             , ("All ", [ [ ("dog", Tag "NN"), ("cat", Tag "NN")] ], 1.0)-             , ("None", [ [ ("the", Tag "DT"), ("couch", Tag "NN")] ], 0)+             [ ("Half", [ TaggedSent [ (POS (RawTag "DT") "the"), (POS (RawTag "NN") "cat")]+                        , TaggedSent [ (POS (RawTag "DT") "the"), (POS (RawTag "NN") "dog")] ], 0.5)+             , ("All ", [ TaggedSent [ (POS (RawTag "NN") "dog"), (POS (RawTag "NN") "cat")] ], 1.0)+             , ("None", [ TaggedSent [ (POS (RawTag "DT") "the"), (POS (RawTag "NN") "couch")] ], 0)              ]         , testGroup "Serialization"              [ testProperty "1 LiteralTagger" (prop_taggersRoundTrip mamalTagger)@@ -27,14 +27,14 @@              ]         ] -animalTagger :: POSTagger-animalTagger = LT.mkTagger (Map.fromList [("owl", Tag "NN"), ("flea", Tag "NN")]) LT.Sensitive (Just mamalTagger)+animalTagger :: POSTagger RawTag+animalTagger = LT.mkTagger (Map.fromList [("owl", RawTag "NN"), ("flea", RawTag "NN")]) LT.Sensitive (Just mamalTagger) -mamalTagger :: POSTagger-mamalTagger = LT.mkTagger (Map.fromList [("cat", Tag "NN"), ("dog", Tag "NN")]) LT.Sensitive Nothing+mamalTagger :: POSTagger RawTag+mamalTagger = LT.mkTagger (Map.fromList [("cat", RawTag "NN"), ("dog", RawTag "NN")]) LT.Sensitive Nothing  -- TODO need to make random taggers to really test this...-prop_taggersRoundTrip :: POSTagger -> String -> Bool+prop_taggersRoundTrip :: POSTagger RawTag -> String -> Bool prop_taggersRoundTrip tgr input =-  let Right roundTripped = deserialize taggerTable $ serialize tgr+  let Right roundTripped = (deserialize taggerTable $ serialize tgr) :: Either String (POSTagger RawTag)   in tagStr tgr ("cat owl " ++ input) == tagStr roundTripped ("cat owl " ++ input)