chatter 0.0.0.1 → 0.0.0.2
raw patch · 9 files changed
+448/−1 lines, 9 files
Files
- chatter.cabal +12/−1
- tests/src/AvgPerceptronTests.hs +57/−0
- tests/src/BackoffTaggerTests.hs +33/−0
- tests/src/Corpora.hs +36/−0
- tests/src/NLP/POS/UnambiguousTaggerTests.hs +48/−0
- tests/src/NLP/POSTests.hs +44/−0
- tests/src/NLP/Similarity/VectorSimBench.hs +64/−0
- tests/src/NLP/Similarity/VectorSimTests.hs +101/−0
- tests/src/TestUtils.hs +53/−0
chatter.cabal view
@@ -1,5 +1,5 @@ name: chatter-version: 0.0.0.1+version: 0.0.0.2 synopsis: A library of simple NLP algorithms. description: chatter is a collection of simple Natural Language Processing algorithms.@@ -112,6 +112,9 @@ Main-Is: Bench.hs hs-source-dirs: tests/src + Other-modules: NLP.Similarity.VectorSimBench+ Corpora+ Build-depends: chatter, criterion, filepath,@@ -128,6 +131,14 @@ Main-Is: Main.hs hs-source-dirs: tests/src++ Other-modules: AvgPerceptronTests+ BackoffTaggerTests+ NLP.Similarity.VectorSimTests+ NLP.POSTests+ NLP.POS.UnambiguousTaggerTests+ Corpora+ TestUtils Build-depends: chatter, base >= 4 && <= 6,
+ tests/src/AvgPerceptronTests.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module AvgPerceptronTests where++import Control.Applicative ((<$>))+import Test.QuickCheck ( Arbitrary(..) )+import Test.QuickCheck.Instances ()+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework ( testGroup, Test )++import Data.Serialize (encode, decode)+import Data.Map (Map)++import NLP.POS.AvgPerceptron++tests :: Test+tests = testGroup "AvgPerceptron"+ [ testGroup "Encoding tests"+ [ testProperty "Features round-trip" prop_featureRoundtrips+ , testProperty "Perceptrons round-trip" prop_perceptronRoundtrips+ , testProperty "Map of features round-trip" prop_mapOfFeaturesRoundTrips+ ]+ ]++prop_mapOfFeaturesRoundTrips :: Map Feature Class -> Bool+prop_mapOfFeaturesRoundTrips aMap =+ case (decode . encode) aMap of+ Left _ -> False+ Right m -> m == aMap++prop_featureRoundtrips :: Feature -> Bool+prop_featureRoundtrips feat =+ case (decode . encode) feat of+ Left _ -> False+ Right f -> f == feat++prop_perceptronRoundtrips :: Perceptron -> Bool+prop_perceptronRoundtrips per =+ case (decode . encode) per of+ Left _ -> False+ Right p -> p == per++instance Arbitrary Feature where+ arbitrary = Feat <$> arbitrary++instance Arbitrary Class where+ arbitrary = Class <$> arbitrary++instance Arbitrary Perceptron where+ arbitrary = do ws <- arbitrary+ ts <- arbitrary+ times <- arbitrary+ counts <- arbitrary+ return Perceptron { weights = ws+ , totals = ts+ , tstamps = times+ , instances = counts+ }
+ tests/src/BackoffTaggerTests.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+module BackoffTaggerTests where++import Test.HUnit ( (@=?), Assertion )+import Test.Framework ( testGroup, Test )+import Test.Framework.Providers.HUnit (testCase)++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Text (Text)++import NLP.Types+import NLP.POS++import qualified NLP.POS.LiteralTagger as LT++tests :: Test+tests = testGroup "Backoff Tagging"+ [ testCase "Simple back-off tagging" testLiteralBackoff+ ]++tagCat :: Map Text Tag+tagCat = Map.fromList [("cat", Tag "CAT")]++tagAnimals :: Map Text Tag+tagAnimals = Map.fromList [("cat", Tag "NN"), ("dog", Tag "NN")]++testLiteralBackoff :: Assertion+testLiteralBackoff = let+ tgr = LT.mkTagger tagCat (Just $ LT.mkTagger tagAnimals Nothing)+ actual = tag tgr "cat dog"+ oracle = [[("cat", Tag "CAT"), ("dog", Tag "NN")]]+ in oracle @=? actual
+ tests/src/Corpora.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+module Corpora where++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 ./."++miniCorpora2 :: Text+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/NLP/POS/UnambiguousTaggerTests.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}+module NLP.POS.UnambiguousTaggerTests where++import Test.HUnit ( (@=?), Assertion )+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")+ ]+ , 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")+ ]+ ]++emptyTagger :: POSTagger+emptyTagger = UT.mkTagger Map.empty Nothing++trainedTagger :: POSTagger+trainedTagger = UT.mkTagger (Map.fromList [("the", Tag "dt"), ("dog", Tag "vb")]) Nothing++prop_emptyAlwaysUnk :: String -> Bool+prop_emptyAlwaysUnk input = all (\(_, y) -> y == tagUNK) (concat $ tag emptyTagger inputTxt)+ where inputTxt = T.pack input++trainAndTagTest :: POSTagger -> (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
+ tests/src/NLP/POSTests.hs view
@@ -0,0 +1,44 @@+{-# 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+import qualified NLP.POS.LiteralTagger as LT++import TestUtils++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)+ ]+ , testGroup "Serialization"+ [ testProperty "1 LiteralTagger" (prop_taggersRoundTrip mamalTagger)+ , testProperty "2 LiteralTaggers" (prop_taggersRoundTrip animalTagger)+ ]+ ]++animalTagger :: POSTagger+animalTagger = LT.mkTagger (Map.fromList [("owl", Tag "NN"), ("flea", Tag "NN")]) (Just mamalTagger)++mamalTagger :: POSTagger+mamalTagger = LT.mkTagger (Map.fromList [("cat", Tag "NN"), ("dog", Tag "NN")]) Nothing++-- TODO need to make random taggers to really test this...+prop_taggersRoundTrip :: POSTagger -> String -> Bool+prop_taggersRoundTrip tgr input =+ let Right roundTripped = deserialize taggerTable $ serialize tgr+ in tagStr tgr ("cat owl " ++ input) == tagStr roundTripped ("cat owl " ++ input)
+ tests/src/NLP/Similarity/VectorSimBench.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}+module NLP.Similarity.VectorSimBench where++import Data.List.Split (splitWhen)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Criterion (bench, whnf, Benchmark)++import NLP.Tokenize (tokenize)+import NLP.Similarity.VectorSim+import NLP.Types (mkCorpus, Corpus)++benchmarks :: [[Text]] -> [[Text]] -> [Benchmark]+benchmarks docs testDocs = let+ corpus = mkCorpus docs+ in [ bench "Doc 1-2 vs 3-4" $ whnf (similarity corpus (concat $ take 2 testDocs))+ ((testDocs!!2) ++ (testDocs!!3))+ , bench "Doc 1-5 vs 6-10" $ whnf (similarity corpus (concat $ take 5 testDocs))+ (concat $ take 5 $ drop 5 testDocs)+ , bench "all pairs of 1-5" $ whnf (docsRunAllPairs corpus) (take 5 testDocs)++ , bench "TV all pairs of 1-5" $ whnf (tvDocsRunAllPairs corpus) (take 5 testDocs)+ ]++docsRunAllPairs :: Corpus -> [[Text]] -> Double+docsRunAllPairs _ [] = 0+docsRunAllPairs corpus (d:ds) = let+ firstRow = foldl (\v doc -> v + similarity corpus d doc) 0 ds+ in firstRow + (docsRunAllPairs corpus ds)++tvDocsRunAllPairs :: Corpus -> [[Text]] -> Double+tvDocsRunAllPairs corpus docs = runVectors (map (mkVector corpus) docs)+ where+ runVectors :: [TermVector] -> Double+ runVectors [] = 0+ runVectors (d:ds) = let+ firstRow = foldl (\v doc -> v + tvSim d doc) 0 ds+ in firstRow + (runVectors ds)+++readMucCorpus :: String -> IO [[Text]]+readMucCorpus file = do+ content <- T.readFile ("./tests/resources/corpora/muc3_4/"++file)+ let+ docMarker :: Text -> Bool+ docMarker txt = "DEV-MUC3-" `T.isPrefixOf` txt++ docLines :: [[Text]]+ docLines = splitWhen docMarker $ T.lines content++ documents :: [Text]+ documents = map T.unlines docLines++ return $ map tokenize documents++muc3_01 :: IO [[Text]]+muc3_01 = readMucCorpus "dev-muc3-0001-0100"++muc3_02 :: IO [[Text]]+muc3_02 = readMucCorpus "dev-muc3-0101-0200"++muc3_03 :: IO [[Text]]+muc3_03 = readMucCorpus "dev-muc3-0201-0300"
+ tests/src/NLP/Similarity/VectorSimTests.hs view
@@ -0,0 +1,101 @@+{-# 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.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+import NLP.Types (mkCorpus)++import TestUtils++tests :: Test+tests = testGroup "Vector Sim"+ [ -- testGroup "Dot Products" $ map (genTestF2 dotProd)+ -- [ ("3-4-5", [1,3,-5], [4, -2, -1], 3)+ -- , ("identical", [1], [1], 1.0)+ -- , ("orthogonal", [1,0], [0,1], 0)+ -- ]+ -- , testGroup "cosines" $ map (genTestF2 cosVec)+ -- -- ("identical", [0], [0], NaN) -- can't determine the angle.+ -- [ ("identical", [1], [1], 1.0)+ -- , ("identical", [1,2], [1,2], 1.0)+ -- , ("orthogonal", [1,0], [0,1], 0)+ -- ]+ -- , testGroup "Magnitude tests" $ map (genTest magnitude)+ -- [ ("3-4-5", [3,4], 5)+ -- , ("empty", [], 0)+ -- , ("single", [1], 1)+ -- ]+ testGroup "tf tests" $ map (genTest2 tf)+ [ ("", "test", ["test"], 1)+ , ("", "a", ["a", "test"], 1)+ , ("", "a", ["test"], 0)+ ]+ , testGroup "idf tests" $ map (genTestF2 idf)+ [ ("", "test", mkCorpus [["test"]], log(1/2))+ , ("", "a", mkCorpus [["test"]], log(1))+ , ("", "a", mkCorpus [["a", "test"],["test"]], log(2/2))+ ]+ , testGroup "tf_idf tests" $ map (genTestF3 tf_idf)+ [ ("", "test", ["test"], mkCorpus [["test"]], log(2/3))+ , ("", "a", ["a", "test"], mkCorpus [["some"], ["test"]], 0.40546)+ , ("", "foo", ["foo"], mkCorpus [["test"]], 0)+ , ("", "foo", ["foo"], mkCorpus [["foo"],["test"]], 0)+ , ("", "bar", ["foo"], mkCorpus [["test"]], 0)+ , ("", "bar", ["foo"], mkCorpus [["foo"],["test"]], 0)+ ]+ , testGroup "Similarity tests, trivial corpus" $+ map (genTest2 $ sim $ mkCorpus [["test"]])+ [ ("same doc", "test", "test", 1)+ -- This next test is invalid becausse the+ -- initial smoothing causes funny results (this+ -- should not be 1.0, and it /is not/ when the+ -- corpus is bigger.)+ , ("one off", "a test", "the test", 1.0)+ , ("No match", "foo", "bar", 0.0)+ ]+ , testGroup "Similarity tests, minor corpus" $+ map (genTestF2 $ sim $ mkCorpus [ ["a", "sample"]+ , ["the", "test"]+ , ["big", "example"]+ , ["more", "terms"]])+ [ ("same doc", "test", "test", 1)+ , ("one off", "a test", "the test", 0.5)+ , ("No match", "foo", "bar", 0.0)+ ]+ , testProperty "idf /= NaN" prop_idfIsANum+ , testProperty "tf_idf /= NaN" prop_tf_idfIsANum+ , testProperty "similarity /= NaN" prop_similarity_isANum+ ]++prop_idfIsANum :: String -> [[String]] -> Bool+prop_idfIsANum term docs = not (isNaN (idf termTxt $ mkCorpus docsTxt))+ where+ termTxt = T.pack term+ docsTxt = map (map T.pack) docs++prop_tf_idfIsANum :: String -> [String] -> [[String]] -> Bool+prop_tf_idfIsANum term doc docs = not $ isNaN $ tf_idf termTxt docTxt $ mkCorpus docsTxt+ where+ termTxt = T.pack term+ docTxt = map T.pack doc+ docsTxt = map (map T.pack) docs++prop_similarity_isANum :: [[String]] -> [String] -> [String] -> Property+prop_similarity_isANum strCorp d1 d2 = strCorp /= [] &&+ (concat d1 /= []) &&+ (concat d2 /= [])==> let+ corpus = mkCorpus $ map (map T.pack) strCorp+ doc1 = map T.pack d1+ doc2 = map T.pack d2+ in not $ isNaN $ similarity corpus doc1 doc2
+ tests/src/TestUtils.hs view
@@ -0,0 +1,53 @@+module TestUtils where+++import Control.Monad (unless)+import Test.HUnit ( (@=?), Assertion, assertFailure )+import Test.Framework.Providers.HUnit (testCase)+import Test.Framework (Test)++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+ where assert = assertApproxEquals "" 0.001 oracle $ fn in1 in2++genTest3 :: (Show a, Show b, Show c, Show d, Eq d)+ => (a -> b -> c -> d)+ -> (String, a, b, c, d)+ -> Test+genTest3 fn (descr, in1, in2, in3, oracle) =+ testCase (descr++" [input: "++show in1++"," ++show in2++"," ++show in3++"]") assert+ where assert = oracle @=? fn in1 in2 in3++genTestF3 :: (Show a, Show b, Show c)+ => (a -> b -> c -> Double)+ -> (String, a, b, c, Double)+ -> Test+genTestF3 fn (descr, in1, in2, in3, oracle) =+ testCase (descr++" [input: "++show in1++"," ++show in2++"," ++show in3++"]") assert+ where assert = assertApproxEquals "" 0.001 oracle $ fn in1 in2 in3++genTest2 :: (Show a, Show b, Show c, Eq c) => (a -> b -> c) -> (String, a, b, c) -> Test+genTest2 fn (descr, in1, in2, oracle) =+ testCase (descr++" [input: "++show in1++"," ++show in2++"]") assert+ where assert = oracle @=? fn in1 in2++genTest :: (Show a, Show b, Eq b) => (a -> b) -> (String, a, b) -> Test+genTest fn (descr, input, oracle) =+ testCase (descr++" [input: "++show input++"]") assert+ where assert = oracle @=? fn input++genTestF :: Show a => (a -> Double) -> (String, a, Double) -> Test+genTestF fn (descr, input, oracle) =+ testCase (descr++" [input: "++show input++"]") assert+ where assert = assertApproxEquals "" 0.001 oracle $ fn input++assertApproxEquals :: String -- ^ The message prefix+ -> Double -- ^ The maximum difference between expected and actual+ -> Double -- ^ The expected value+ -> Double -- ^ The actual value+ -> Assertion+assertApproxEquals preface delta expected actual =+ unless (abs (expected - actual) < delta) (assertFailure msg)+ where msg = (if null preface then "" else preface ++ "\n") +++ "expected: " ++ show expected ++ "\n but got: " ++ show actual