chatter 0.1.0.5 → 0.2.0.0
raw patch · 16 files changed
+370/−90 lines, 16 filesdep +arraydep +parsecdep +regex-basedep ~tokenize
Dependencies added: array, parsec, regex-base, regex-tdfa, regex-tdfa-text, transformers
Dependency ranges changed: tokenize
Files
- chatter.cabal +15/−2
- src/NLP/Corpora/Email.hs +0/−3
- src/NLP/Extraction/Parsec.hs +99/−0
- src/NLP/POS.hs +22/−19
- src/NLP/POS/AvgPerceptron.hs +1/−1
- src/NLP/POS/LiteralTagger.hs +96/−19
- src/NLP/POS/UnambiguousTagger.hs +5/−2
- src/NLP/Types.hs +20/−0
- tests/src/BackoffTaggerTests.hs +1/−1
- tests/src/Corpora.hs +0/−22
- tests/src/Main.hs +5/−1
- tests/src/NLP/Extraction/ParsecTests.hs +89/−0
- tests/src/NLP/POS/UnambiguousTaggerTests.hs +9/−9
- tests/src/NLP/POSTests.hs +2/−6
- tests/src/NLP/Similarity/VectorSimTests.hs +1/−5
- tests/src/TestUtils.hs +5/−0
chatter.cabal view
@@ -1,5 +1,5 @@ name: chatter-version: 0.1.0.5+version: 0.2.0.0 synopsis: A library of simple NLP algorithms. description: chatter is a collection of simple Natural Language Processing algorithms.@@ -13,6 +13,8 @@ . * Document similarity; A cosine-based similarity measure, and TF-IDF calculations, are available in the 'NLP.Similarity.VectorSim' module.+ .+ * Information Extraction patterns via (<http://www.haskell.org/haskellwiki/Parsec/>) Parsec homepage: http://github.com/creswick/chatter Bug-Reports: http://github.com/creswick/chatter/issues category: Natural language processing@@ -45,6 +47,7 @@ NLP.Corpora.Parsing NLP.Corpora.Email NLP.Similarity.VectorSim+ NLP.Extraction.Parsec Data.DefaultMap Build-depends: base >= 4 && <= 6,@@ -63,8 +66,15 @@ filepath >= 1.3.0.1, ghc-prim, deepseq,- tokenize >= 0.2.0+ tokenize >= 0.2.0,+ parsec >= 3.1.5,+ transformers,+ regex-base,+ regex-tdfa >= 1.2.0,+ regex-tdfa-text,+ array + ghc-options: -Wall @@ -145,6 +155,7 @@ NLP.Similarity.VectorSimTests NLP.POSTests NLP.POS.UnambiguousTaggerTests+ NLP.Extraction.ParsecTests NLP.TypesTests Data.DefaultMapTests Corpora@@ -154,10 +165,12 @@ base >= 4 && <= 6, text, HUnit,+ parsec >= 3.1.5, test-framework, test-framework-skip, test-framework-quickcheck2, test-framework-hunit,+ tokenize, QuickCheck < 2.6, filepath, cereal,
src/NLP/Corpora/Email.hs view
@@ -4,10 +4,7 @@ import qualified Data.ByteString as BS import Data.List (isSuffixOf)-import Data.List.Split (splitWhen) import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.IO as T import qualified Data.Text.Encoding as TE import Data.MBox
+ src/NLP/Extraction/Parsec.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts #-}++-- | This is a very simple wrapper around Parsec for writing+-- Information Extraction patterns.+--+-- Because the particular tags/tokens to parse depends on the training+-- corpus (for POS tagging) and the domain, this module only provides+-- basic extractors. You can, for example, create an extractor to+-- find noun phrases by combining the components provided here:+--+-- @+-- nounPhrase :: Extractor (Text, Tag)+-- nounPhrase = do+-- nlist <- many1 (try (posTok $ Tag "NN")+-- <|> try (posTok $ Tag "DT")+-- <|> (posTok $ Tag "JJ"))+-- let term = T.intercalate " " (map fst nlist)+-- return (term, Tag "n-phr")+-- @+module NLP.Extraction.Parsec++where++-- See this SO q/a for some possibly useful combinators:+-- http://stackoverflow.com/questions/2473615/parsec-3-1-0-with-custom-token-datatype++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 qualified Text.Parsec.Combinator as PC+import Text.Parsec.Pos (newPos)++import NLP.Types (TaggedSentence, Tag(..), CaseSensitive(..))++-- | A Parsec parser.+--+-- Example usage:+-- > set -XOverloadedStrings+-- > import Text.Parsec.Prim+-- > parse myExtractor "interactive repl" someTaggedSentence+--+type Extractor = Parsec TaggedSentence ()++-- | Consume a token with the given POS Tag+posTok :: Tag -> Extractor (Text, Tag)+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++-- | Consume a token with the specified POS prefix.+--+-- > parse (posPrefix "n") "ghci" [("Bob", Tag "np")]+-- Right [("Bob", Tag "np")]+--+posPrefix :: Text -> Extractor (Text, Tag)+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++-- | Text equality matching with optional case sensitivity.+matches :: CaseSensitive -> Text -> Text -> Bool+matches Sensitive x y = x == y+matches Insensitive x y = (T.toLower x) == (T.toLower y)++-- | Consume a token with the given lexical representation.+txtTok :: CaseSensitive -> Text -> Extractor (Text, Tag)+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++-- | Consume any one non-empty token.+anyToken :: Extractor (Text, Tag)+anyToken = token showTok posFromTok testTok+ where+ showTok (txt,_) = show txt+ posFromTok (_,_) = newPos "unknown" 0 0+ testTok tok@(txt,_) | txt == "" = Nothing+ | otherwise = Just tok++oneOf :: CaseSensitive -> [Text] -> Extractor (Text, Tag)+oneOf sensitive terms = PC.choice (map (\t -> try (txtTok sensitive t)) terms)++-- | Skips any number of fill tokens, ending with the end parser, and+-- returning the last parsed result.+--+-- 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 fill end = do+ _ <- PC.manyTill fill (lookAhead end)+ end
src/NLP/POS.hs view
@@ -26,6 +26,7 @@ , train , trainStr , trainText+ , tagTokens , eval , serialize , deserialize@@ -37,28 +38,29 @@ where -import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS-import Data.List (isSuffixOf)-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Text (Text)-import qualified Data.Text as T-import Data.Serialize (encode, decode)-import Codec.Compression.GZip (decompress)-import System.FilePath ((</>))--import NLP.Corpora.Parsing (readPOS)+import Codec.Compression.GZip (decompress)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Data.List (isSuffixOf)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Serialize (decode, encode)+import Data.Text (Text)+import qualified Data.Text as T+import System.FilePath ((</>)) -import NLP.Types (TaggedSentence, Tag(..), Sentence- , POSTagger(..), tagUNK, stripTags)+import NLP.Corpora.Parsing (readPOS)+import NLP.Tokenize.Text (tokenize)+import NLP.Types (POSTagger (..), Sentence,+ Tag (..), TaggedSentence,+ stripTags, tagUNK) -import qualified NLP.POS.LiteralTagger as LT-import qualified NLP.POS.UnambiguousTagger as UT import qualified NLP.POS.AvgPerceptronTagger as Avg+import qualified NLP.POS.LiteralTagger as LT+import qualified NLP.POS.UnambiguousTagger as UT -import Paths_chatter+import Paths_chatter defaultTagger :: IO POSTagger defaultTagger = do@@ -179,7 +181,7 @@ -- | The `Text` version of `trainStr` trainText :: POSTagger -> Text -> IO POSTagger-trainText p exs = train p (map readPOS $ (posTokenizer p) exs)+trainText p exs = train p (map readPOS $ tokenize exs) -- | Train a 'POSTagger' on a corpus of sentences. --@@ -206,6 +208,7 @@ Just b -> do tgr <- train b exs return $ Just tgr trainer = posTrainer p+ putStrLn ("train - exs: "++show exs) newTgr <- trainer exs newBackoff <- trainBackoff return (newTgr { posBackoff = newBackoff })
src/NLP/POS/AvgPerceptron.hs view
@@ -26,7 +26,7 @@ import qualified Data.Map.Strict as Map import Data.Map.Strict (Map) import Data.Maybe (fromMaybe)-import Data.Serialize (Serialize, put, get)+import Data.Serialize (Serialize) import Data.Text (Text) import System.Random.Shuffle (shuffleM) import GHC.Generics
src/NLP/POS/LiteralTagger.hs view
@@ -1,54 +1,131 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} module NLP.POS.LiteralTagger ( tag , tagSentence , mkTagger , taggerID , readTagger+ , CaseSensitive(..)+ , protectTerms ) where ++import GHC.Generics++import Control.Monad ((>=>))+import Data.Array import Data.ByteString (ByteString) import Data.ByteString.Char8 (pack)+import Data.Function (on)+import Data.List (sortBy) import qualified Data.Map.Strict as Map-import Data.Serialize (encode, decode)+import Data.Serialize (Serialize, encode, decode) import Data.Map.Strict (Map) import Data.Text (Text) import qualified Data.Text as T -import NLP.Tokenize.Text (tokenize)+import NLP.Tokenize.Text (Tokenizer, EitherList(..), defaultTokenizer, run) import NLP.FullStop (segment) import NLP.Types ( tagUNK, Sentence, TaggedSentence- , Tag, POSTagger(..))+ , Tag, POSTagger(..), CaseSensitive(..))+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. -- -- 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 -> Maybe POSTagger -> POSTagger-mkTagger table mTgr = POSTagger { posTagger = tag table- , posTrainer = \_ -> return $ mkTagger table mTgr- , posBackoff = mTgr- , posTokenizer = tokenize- , posSplitter = (map T.pack) . segment . T.unpack- , posSerialize = encode table- , posID = taggerID- }+mkTagger :: Map Text Tag -> CaseSensitive -> Maybe POSTagger -> POSTagger+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)+ , posSplitter = (map T.pack) . segment . T.unpack+ , posSerialize = encode (table, sensitive)+ , posID = taggerID+ }+ where canonicalize :: Map Text Tag -> Map Text Tag+ canonicalize =+ case sensitive of+ Sensitive -> id+ Insensitive -> Map.mapKeys T.toLower -tag :: Map Text Tag -> [Sentence] -> [TaggedSentence]-tag table ss = map (tagSentence table) ss -tagSentence :: Map Text Tag -> Sentence -> TaggedSentence-tagSentence table toks = map findTag toks+-- | Create a tokenizer that protects the provided terms (to tokenize+-- multi-word terms)+protectTerms :: [Text] -> CaseSensitive -> Tokenizer+protectTerms terms sensitive =+ let sorted = sortBy (compare `on` T.length) terms++ sensitivity = case sensitive of+ Insensitive -> False+ Sensitive -> True++ compOption = CompOption+ { caseSensitive = sensitivity+ , multiline = False+ , rightAssoc = True+ , newSyntax = True+ , lastStarGreedy = True+ }++ execOption = ExecOption { captureGroups = False }++ eRegex = compile compOption execOption (T.concat ["\\<", (T.intercalate "\\>|\\<" sorted), "\\>"])++ toEithers :: [(Int, Int)] -> Text -> [Either Text Text]+ toEithers [] str = [Right str]+ toEithers ((idx, len):rest) str =+ let (first, theTail) = T.splitAt idx str+ (token, realTail) = T.splitAt len theTail+ scaledRest = map (\(x,y)->((x-(idx+len)), y)) rest+ in filterEmpty ([Right first, Left token] ++ (toEithers scaledRest realTail))++ filterEmpty :: [Either Text Text] -> [Either Text Text]+ filterEmpty [] = []+ filterEmpty (Left "":xs) = filterEmpty xs+ filterEmpty (Right "":xs) = filterEmpty xs+ filterEmpty (x:xs) = x:filterEmpty xs++ tokenizeMatches :: Regex -> Tokenizer+ tokenizeMatches regex tok =+ E (toEithers (concatMap elems $ matchAll regex tok) tok)+ in case eRegex of+ Left err -> error ("Regex could not be built: "++err)+ Right rx -> tokenizeMatches rx++ -- x | isUri x = E [Left x]+ -- | True = E [Right x]+ -- where isUri u = any (`T.isPrefixOf` u) ["http://","ftp://","mailto:"]++tag :: Map Text Tag -> CaseSensitive -> [Sentence] -> [TaggedSentence]+tag table sensitive ss = map (tagSentence table sensitive) ss++tagSentence :: Map Text Tag -> CaseSensitive -> Sentence -> TaggedSentence+tagSentence table sensitive toks = map findTag toks where findTag :: Text -> (Text, Tag)- findTag txt = (txt, Map.findWithDefault tagUNK txt table)+ findTag txt = (txt, Map.findWithDefault tagUNK (canonicalize txt) table) + canonicalize :: Text -> Text+ canonicalize =+ case sensitive of+ Sensitive -> id+ Insensitive -> T.toLower++-- | 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 bs backoff = do- model <- decode bs- return $ mkTagger model backoff+ (model, sensitive) <- decode bs+ return $ mkTagger model sensitive backoff
src/NLP/POS/UnambiguousTagger.hs view
@@ -33,11 +33,14 @@ -- source of tags. mkTagger :: Map Text Tag -> Maybe POSTagger -> POSTagger mkTagger table mTgr = let- litTagger = LT.mkTagger table mTgr+ litTagger = LT.mkTagger table LT.Sensitive mTgr trainer :: [TaggedSentence] -> IO POSTagger trainer exs = do let newTable = train table exs+ putStrLn ("exs: "++show exs)+ putStrLn ("table: "++show table)+ putStrLn ("new table: "++show newTable) return $ mkTagger newTable mTgr in litTagger { posTrainer = trainer@@ -57,7 +60,7 @@ incorporate :: Tag -> Maybe Tag -> Maybe Tag incorporate new Nothing = Just new incorporate new (Just old) | new == old = Just old- | otherwise = Nothing+ | otherwise = Just tagUNK -- Forget the tag. in foldl trainOnPair table pairs
src/NLP/Types.hs view
@@ -12,11 +12,31 @@ import Data.Set (Set) 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++-- | Boolean type to indicate case sensitivity for textual+-- comparisons.+data CaseSensitive = Sensitive | Insensitive+ deriving (Read, Show, Generic) -- | Part of Speech tagger, with back-off tagger.
tests/src/BackoffTaggerTests.hs view
@@ -27,7 +27,7 @@ testLiteralBackoff :: Assertion testLiteralBackoff = let- tgr = LT.mkTagger tagCat (Just $ LT.mkTagger tagAnimals Nothing)+ 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")]] in oracle @=? actual
tests/src/Corpora.hs view
@@ -3,11 +3,7 @@ import Data.Text (Text) import qualified Data.Text as T-import qualified Data.Text.IO as T -import System.FilePath ((</>))-import Text.Printf (printf)- -- | A very small (one-sentence) training corpora for tests. miniCorpora1 :: Text miniCorpora1 = "the/DT dog/NN jumped/VB ./."@@ -16,21 +12,3 @@ miniCorpora2 = T.unlines [ "the/DT dog/NN jumped/VB ./." , "a/DT dog/NN barks/VB ./." ]---- brownCorporaDir :: FilePath--- brownCorporaDir = "/home/creswick/nltk_data/corpora/brown"---- brownCA01 :: FilePath--- brownCA01 = brownCAFiles!!0---- brownCA :: IO Text--- brownCA = do--- let files = brownCAFiles--- contents <- mapM T.readFile files--- return $ T.unlines contents---- brownFile :: String -> Int -> String--- brownFile cat num = printf (cat++"%02d") num---- brownCAFiles :: [FilePath]--- brownCAFiles = map (\n->brownCorporaDir </> (brownFile "ca" n)) [1..44]
tests/src/Main.hs view
@@ -11,7 +11,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) import Test.Framework ( buildTest, testGroup, Test, defaultMain )-import Test.Framework.Skip (skip)+-- import Test.Framework.Skip (skip) import NLP.Types (Tag(..), parseTag) import NLP.POS (tagText, train)@@ -23,8 +23,10 @@ import qualified NLP.Similarity.VectorSimTests as Vec import qualified NLP.POSTests as POS import qualified NLP.POS.UnambiguousTaggerTests as UT+import qualified NLP.POS.LiteralTaggerTests as LT import qualified NLP.TypesTests as TypeTests import qualified Data.DefaultMapTests as DefMap+import qualified NLP.Extraction.ParsecTests as Parsec import Corpora @@ -59,8 +61,10 @@ , Vec.tests , POS.tests , UT.tests+ , LT.tests , TypeTests.tests , DefMap.tests+ , Parsec.tests ]
+ tests/src/NLP/Extraction/ParsecTests.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverlappingInstances #-}+module NLP.Extraction.ParsecTests where++----------------------------------------------------------------------+import Test.QuickCheck ( Arbitrary, arbitrary, (==>), Property+ , NonEmptyList(..), listOf)+import Test.QuickCheck.Instances ()+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework ( testGroup, Test )+----------------------------------------------------------------------+import qualified Data.Text as T+import Data.Text (Text)+import Text.Parsec.Prim (parse, (<|>), try)+import Text.Parsec.Pos+import qualified Text.Parsec.Combinator as PC+----------------------------------------------------------------------+import NLP.Types+import NLP.Extraction.Parsec++import TestUtils++tests :: Test+tests = testGroup "NLP.Extraction.Parsec"+ [ testProperty "posTok extraction" prop_posTok+ , testProperty "anyToken" prop_anyToken+ , 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")]+ , 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+ Right actual = parse (posTok firstTag) "prop_posTag" taggedSent+ in (firstTok, firstTag) == actual++prop_anyToken :: TaggedSentence -> Property+prop_anyToken taggedSent = taggedSent /= [] ==>+ let actual = parse anyToken "prop_anyToken" taggedSent+ in isRight actual++prop_followedBy :: TaggedSentence -> Property+prop_followedBy taggedSent = taggedSent /= []+ && not (contains taggedSent ".") ==>+ let (theToken, theTag) = (".", Tag ".")+ extractor = followedBy anyToken $ txtTok Insensitive theToken+ Right actual = parse extractor "prop_followedBy"+ (taggedSent ++ [(theToken, theTag)])+ in (theToken, theTag) == actual+++nounPhrase :: Extractor (Text, 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")++parseNounPhrase :: TaggedSentence -> Maybe (Text, Tag)+parseNounPhrase sent =+ case parse nounPhrase "parseNounPhrase Test" sent of+ Left _ -> Nothing+ Right v -> Just v
tests/src/NLP/POS/UnambiguousTaggerTests.hs view
@@ -1,34 +1,34 @@ {-# LANGUAGE OverloadedStrings #-} module NLP.POS.UnambiguousTaggerTests where -import Test.HUnit ( (@=?), Assertion )+import Test.HUnit ( (@=?) ) import Test.Framework ( testGroup, Test ) import Test.Framework.Providers.HUnit (testCase) import Test.QuickCheck () import Test.Framework.Providers.QuickCheck2 (testProperty) -import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as T import NLP.Types import NLP.POS-import qualified NLP.POS.LiteralTagger as LT import qualified NLP.POS.UnambiguousTagger as UT -import TestUtils- tests :: Test tests = testGroup "NLP.POS.UnambiguousTagger" [ testProperty "basic tag parsing" prop_emptyAlwaysUnk , testGroup "Initial training" $ map (trainAndTagTest emptyTagger)- [ ("the/dt dog/nn jumped/vb", "a dog", "a/Unk dog/nn")- , ("the/dt dog/nn jumped/vb jumped/vbx", "a dog jumped", "a/Unk dog/nn jumped/Unk")+ [ ("the/dt dog/nn jumped/vb", "a dog"+ , "a/Unk dog/nn")+ , ("the/dt dog/nn jumped/vb jumped/vbx", "a dog jumped"+ , "a/Unk dog/nn jumped/Unk") ] , testGroup "Retraining" $ map (trainAndTagTest trainedTagger)- [ ("the/dt dog/nn jumped/vb", "the dog", "the/dt dog/Unk")- , ("the/dt dog/nn jumped/vb jumped/vbx", "the dog jumped", "the/dt dog/Unk jumped/Unk")+ [ ("the/dt dog/nn jumped/vb", "the dog"+ , "the/dt dog/Unk")+ , ("the/dt dog/nn jumped/vb jumped/vbx", "the dog jumped"+ , "the/dt dog/Unk jumped/Unk") ] ]
tests/src/NLP/POSTests.hs view
@@ -1,15 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module NLP.POSTests where -import Test.HUnit ( (@=?), Assertion ) import Test.Framework ( testGroup, Test )-import Test.Framework.Providers.HUnit (testCase) import Test.QuickCheck.Instances () import Test.Framework.Providers.QuickCheck2 (testProperty) -import Data.Map (Map) import qualified Data.Map as Map-import Data.Text (Text) import NLP.Types import NLP.POS@@ -32,10 +28,10 @@ ] animalTagger :: POSTagger-animalTagger = LT.mkTagger (Map.fromList [("owl", Tag "NN"), ("flea", Tag "NN")]) (Just mamalTagger)+animalTagger = LT.mkTagger (Map.fromList [("owl", Tag "NN"), ("flea", Tag "NN")]) LT.Sensitive (Just mamalTagger) mamalTagger :: POSTagger-mamalTagger = LT.mkTagger (Map.fromList [("cat", Tag "NN"), ("dog", Tag "NN")]) Nothing+mamalTagger = LT.mkTagger (Map.fromList [("cat", Tag "NN"), ("dog", Tag "NN")]) LT.Sensitive Nothing -- TODO need to make random taggers to really test this... prop_taggersRoundTrip :: POSTagger -> String -> Bool
tests/src/NLP/Similarity/VectorSimTests.hs view
@@ -1,16 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module NLP.Similarity.VectorSimTests where -import Control.Monad (unless)-import Test.HUnit ( (@=?), Assertion, assertBool, assertFailure )-import Test.QuickCheck ( Arbitrary(..), Property, (==>), elements )+import Test.QuickCheck ( Property, (==>) ) import Test.QuickCheck.Property () import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.Framework.Providers.HUnit (testCase) import Test.Framework ( testGroup, Test) -- import Test.Framework.Skip (skip) -import Data.Text (Text) import qualified Data.Text as T import NLP.Similarity.VectorSim
tests/src/TestUtils.hs view
@@ -6,6 +6,11 @@ import Test.Framework.Providers.HUnit (testCase) import Test.Framework (Test) +-- | Not available until Base 4.7 or greater:+isRight :: Either a b -> Bool+isRight (Left _) = False+isRight (Right _) = True+ genTestF2 :: (Show a, Show b) => (a -> b -> Double) -> (String, a, b, Double) -> Test genTestF2 fn (descr, in1, in2, oracle) = testCase (descr++" [input: "++show in1++"," ++show in2++"]") assert