packages feed

chatter 0.7.0.0 → 0.8.0.0

raw patch · 6 files changed

+64/−31 lines, 6 files

Files

changelog.md view
@@ -1,3 +1,13 @@+= 0.8.0.0 =++ - Added a Document type to better store term count indexes+   (essentially TermVectors with integer values).++ - Used the Document type for tf_idf; this changed the API, and is the+   reason for the B-level version bump. (also done for performance)++ - A number of non-breaking performance improvements (e.g., not using foldl in a few places.)+ = 0.7.0.0 =  - B-level version bump because we added test dependency on    unordered-containers, which could cause downstream issues.
chatter.cabal view
@@ -1,5 +1,5 @@ name:                chatter-version:             0.7.0.0+version:             0.8.0.0 synopsis:            A library of simple NLP algorithms. description:         chatter is a collection of simple Natural Language                      Processing algorithms.
src/Data/DefaultMap.hs view
@@ -6,7 +6,7 @@ import Prelude hiding (lookup) import Control.Applicative ((<$>), (<*>)) import Test.QuickCheck (Arbitrary(..))-import Control.DeepSeq (NFData)+import Control.DeepSeq (NFData(..), deepseq) import qualified Data.HashSet as S import Data.Hashable import Data.HashMap.Strict (HashMap)@@ -25,7 +25,8 @@   put (DefMap d theMap) = put d >> put (Map.toList theMap)   get = DefMap <$> get <*> (Map.fromList <$> get) -instance (NFData k, NFData v, Hashable k) => NFData (DefaultMap k v)+instance (NFData k, NFData v, Hashable k) => NFData (DefaultMap k v) where+    rnf (DefMap d m) = d `deepseq` m `deepseq` ()  -- | Create an empty `DefaultMap` empty :: v -> DefaultMap k v
src/NLP/Similarity/VectorSim.hs view
@@ -1,9 +1,12 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module NLP.Similarity.VectorSim where +import Control.Applicative ((<$>)) import Prelude hiding (lookup) import Data.DefaultMap (DefaultMap) import Test.QuickCheck (Arbitrary(..))+import qualified Data.HashMap.Strict as HM import qualified Data.DefaultMap as DM import qualified Data.Set as Set import Data.Text (Text)@@ -11,11 +14,12 @@ import Data.List (elemIndices) import GHC.Generics import NLP.Types+import Control.DeepSeq (NFData(..), deepseq)  -- | An efficient (ish) representation for documents in the "bag of -- words" sense. newtype TermVector = TermVector (DefaultMap Text Double)-  deriving (Read, Show, Eq, Generic)+  deriving (Read, Show, Eq, Generic, NFData)  instance Arbitrary TermVector where   arbitrary = do@@ -23,15 +27,33 @@     let zeroMap = theMap { DM.defDefault = 0 }     return $ TermVector zeroMap +data Document = Document { docTermFrequencies :: HM.HashMap Text Int+                         , docTokens :: [Text]+                         }+  deriving (Read, Show, Eq, Generic)++instance NFData Document where+  rnf (Document f m) = f `deepseq` m `deepseq` ()++instance Arbitrary Document where+  arbitrary = mkDocument <$> arbitrary++-- | Make a document from a list of tokens.+mkDocument :: [Text] -> Document+mkDocument ts = Document mp ts+    where+        mp = foldr (\t -> HM.insertWith (+) t 1) HM.empty ts+ -- | Access the underlying DefaultMap used to store term vector details. fromTV :: TermVector -> DefaultMap Text Double fromTV (TermVector dm) = dm  -- | Generate a `TermVector` from a tokenized document.-mkVector :: Corpus -> [Text] -> TermVector-mkVector corpus doc = TermVector $ DM.fromList 0 $ Set.toList $-                        Set.map (\t->(t, tf_idf t doc corpus)) (Set.fromList doc)-+mkVector :: Corpus -> Document -> TermVector+mkVector corpus doc =+    TermVector $ DM.DefMap { DM.defDefault = 0+                           , DM.defMap = HM.mapWithKey (\t _ -> tf_idf t doc corpus) (docTermFrequencies doc)+                           }  -- | Invokes similarity on full strings, using `T.words` for -- tokenization, and no stemming. The return value will be in the@@ -56,8 +78,8 @@ -- There *must* be at least one document in the corpus. similarity :: Corpus -> [Text] -> [Text] -> Double similarity corpus doc1 doc2 = let-  vec1 = mkVector corpus doc1-  vec2 = mkVector corpus doc2+  vec1 = mkVector corpus $ mkDocument doc1+  vec2 = mkVector corpus $ mkDocument doc2   in tvSim vec1 vec2  -- | Determine how similar two documents are.@@ -75,23 +97,22 @@ -- The firt argument is the term to find, the second is a tokenized -- document. This function does not do any stemming or additional text -- modification.-tf :: Eq a => a -> [a] -> Int-tf term doc = length $ elemIndices term doc+tf :: Text -> Document -> Int+tf term doc = HM.lookupDefault 0 term (docTermFrequencies doc)  -- | Calculate the inverse document frequency. -- -- The IDF is, roughly speaking, a measure of how popular a term is. idf :: Text -> Corpus -> Double idf term corpus = let-  docCount = corpLength corpus-  containedInCount = 1 + termCounts corpus term+  docCount         = 1 + corpLength corpus+  containedInCount = 2 + termCounts corpus term   in log (fromIntegral docCount / fromIntegral containedInCount)  -- | Calculate the tf*idf measure for a term given a document and a -- corpus.-tf_idf :: Text -> [Text] -> Corpus -> Double-tf_idf term doc corp = let-  corpus = addDocument corp doc+tf_idf :: Text -> Document -> Corpus -> Double+tf_idf term doc corpus = let   freq = tf term doc   result | freq == 0 = 0          | otherwise = (fromIntegral freq) * idf term corpus
src/NLP/Types.hs view
@@ -16,6 +16,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text)+import Data.List (foldl')  import GHC.Generics @@ -102,7 +103,7 @@ -- documents have all been tokenized and the tokens normalized, in the -- same way. addDocument :: Corpus -> [Text] -> Corpus-addDocument (Corpus count m) doc = Corpus (count + 1) (foldl addTerm m doc)+addDocument (Corpus count m) doc = Corpus (count + 1) (foldl' addTerm m doc)  -- | Create a corpus from a list of documents, represented by -- normalized tokens.@@ -110,11 +111,11 @@ mkCorpus docs =   let docSets = map Set.fromList docs   in Corpus { corpLength     = length docs-            , corpTermCounts = foldl addTerms Map.empty docSets+            , corpTermCounts = foldl' addTerms Map.empty docSets             }  addTerms :: Map Text Int -> Set Text -> Map Text Int-addTerms m terms = Set.foldl addTerm m terms+addTerms m terms = Set.foldl' addTerm m terms  addTerm :: Map Text Int -> Text -> Map Text Int addTerm m term = Map.alter increment term m
tests/src/NLP/Similarity/VectorSimTests.hs view
@@ -34,22 +34,22 @@         --   , ("single", [1], 1)         --   ]          testGroup "tf tests" $ map (genTest2 tf)-          [ ("", "test", ["test"], 1)-          , ("", "a", ["a", "test"], 1)-          , ("", "a", ["test"], 0)+          [ ("", "test", mkDocument ["test"], 1)+          , ("", "a",    mkDocument ["a", "test"], 1)+          , ("", "a",    mkDocument ["test"], 0)           ]         , testGroup "idf tests" $ map (genTestF2 idf)-          [ ("", "test", mkCorpus [["test"]], log(1/2))+          [ ("", "test", mkCorpus [["test"]], log(2/3))           , ("", "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)+          [ ("", "test", mkDocument ["test"], mkCorpus [["test"]], log(2/3))+          , ("", "a",    mkDocument ["a", "test"], mkCorpus [["some"], ["test"]], 0.40546)+          , ("", "foo",  mkDocument ["foo"], mkCorpus [["test"]], 0)+          , ("", "foo",  mkDocument ["foo"], mkCorpus [["foo"],["test"]], 0)+          , ("", "bar",  mkDocument ["foo"], mkCorpus [["test"]], 0)+          , ("", "bar",  mkDocument ["foo"], mkCorpus [["foo"],["test"]], 0)           ]         , testGroup "Similarity tests, trivial corpus" $             map (genTest2 $ sim $ mkCorpus [["test"]])@@ -99,7 +99,7 @@     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+prop_tf_idfIsANum term doc docs = not $ isNaN $ tf_idf termTxt (mkDocument docTxt) $ mkCorpus docsTxt   where     termTxt = T.pack term     docTxt = map T.pack doc