diff --git a/appsrc/ChunkTrainer.hs b/appsrc/ChunkTrainer.hs --- a/appsrc/ChunkTrainer.hs +++ b/appsrc/ChunkTrainer.hs @@ -5,7 +5,7 @@ import qualified Data.Text.IO as T import System.Environment (getArgs) -import NLP.POS.AvgPerceptron (emptyPerceptron) +import NLP.ML.AvgPerceptron (emptyPerceptron) import qualified NLP.Chunk.AvgPerceptronChunker as Avg import NLP.Chunk (train, saveChunker) import NLP.Types.IOB diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,34 @@ += 0.5.0.0 = + + - Added chunk, chunkText, and chunkStr functions to NLP.Chunk to + make it easier to experiment with the chunker. + + - Added a formatting function to show ChunkedSententences + (NLP.Types.Tree.showChunkedSent) that formats chunks in bracket notation, eg: + + > chunkText tgr chk "The dog jumped over the reluctant cat." + "[NP The/DT dog/NN] [VP jumped/VBD] [NP over/IN the/DT reluctant/JJ cat/NN] ./." + + Notice that the features still need some tuning for the chunker. + + - Moved the AveragePerceptron module into a NLP.ML (Machine Learning) module. + + - Added the 'tags-since-dt' feature to the AveragePerceptronChunker features + and retrained the Conll2000 models. + += 0.4.0.0 = + + - Added phrasal chunking via an Averaged Perceptron Chunker, + trained on the Conll 2000 corpus. + + - Added a POS tagger trained on the Conll 2000 corpus, because the + Conll chunker relies on that tagset. + + - Set the Conll 2000 POS tagger to the defaultTagger. Note that + the tagset is much smaller than the Brown tagset used by the + previous defaultTagger. The Brown tagger is still available from + NLP.POS.brownTagger. + = 0.3.0.1 = - Bumped dependency on base to >= 4.6 (from >= 4) because of diff --git a/chatter.cabal b/chatter.cabal --- a/chatter.cabal +++ b/chatter.cabal @@ -1,5 +1,5 @@ name: chatter -version: 0.4.0.0 +version: 0.5.0.0 synopsis: A library of simple NLP algorithms. description: chatter is a collection of simple Natural Language Processing algorithms. @@ -11,10 +11,17 @@ by Matthew Honnibal: () See 'NLP.POS' for the details of part-of-speech tagging with chatter. . + * Phrasal Chunking (also with an Averaged Perceptron) to identify arbitrary chunks based on training data. + . * Document similarity; A cosine-based similarity measure, and TF-IDF calculations, are available in the 'NLP.Similarity.VectorSim' module. . * Information Extraction patterns via () Parsec + . + Chatter comes with models for POS tagging and + Phrasal Chunking that have been trained on the + Brown corpus (POS only) and the Conll2000 corpus + (POS and Chunking) homepage: http://github.com/creswick/chatter Bug-Reports: http://github.com/creswick/chatter/issues category: Natural language processing @@ -42,12 +49,12 @@ Other-modules: Paths_chatter Exposed-modules: NLP.POS - NLP.POS.AvgPerceptron NLP.POS.AvgPerceptronTagger NLP.POS.LiteralTagger NLP.POS.UnambiguousTagger NLP.Chunk NLP.Chunk.AvgPerceptronChunker + NLP.ML.AvgPerceptron NLP.Types NLP.Types.General NLP.Types.IOB diff --git a/data/models/README b/data/models/README --- a/data/models/README +++ b/data/models/README @@ -21,8 +21,22 @@ 2000 training set. +Generated by: + +$ time ./dist/build/trainPOS/trainPOS ~/nltk_data/corpora/conll2000/train.txt conll2000.pos.model + +real 2m48.866s +user 2m44.500s +sys 0m1.898s + --------------------------------------------------------------------- conll2000.chunk.model.gz --------------------------------------------------------------------- Averaged Perceptron Chunker trained on the Conll 2000 training set. + + $ time ./dist/build/trainChunker/trainChunker ~/nltk_data/corpora/conll2000/train.txt conll2000.chunk.model + +real 0m20.730s +user 0m20.298s +sys 0m0.290s diff --git a/data/models/conll2000.chunk.model.gz b/data/models/conll2000.chunk.model.gz Binary files a/data/models/conll2000.chunk.model.gz and b/data/models/conll2000.chunk.model.gz differ diff --git a/data/models/conll2000.pos.model.gz b/data/models/conll2000.pos.model.gz # file too large to diff: data/models/conll2000.pos.model.gz diff --git a/src/NLP/Chunk.hs b/src/NLP/Chunk.hs --- a/src/NLP/Chunk.hs +++ b/src/NLP/Chunk.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module NLP.Chunk where @@ -9,26 +10,58 @@ 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.POS (tag) import NLP.Types -import NLP.Chunk.AvgPerceptronChunker +import NLP.Chunk.AvgPerceptronChunker (Chunker(..)) import qualified NLP.Chunk.AvgPerceptronChunker as Avg import qualified NLP.Corpora.Conll as C import Paths_chatter +-- | A basic Phrasal chunker. defaultChunker :: IO (Chunker C.Chunk C.Tag) defaultChunker = conllChunker +-- | Convenient function to load the Conll2000 Chunker. conllChunker :: IO (Chunker C.Chunk C.Tag) conllChunker = do dir <- getDataDir loadChunker (dir "data" "models" "conll2000.chunk.model.gz") +-- | Train a chunker on a set of additional examples. train :: (ChunkTag c, Tag t) => Chunker c t -> [ChunkedSentence c t] -> IO (Chunker c t) train ch exs = chTrainer ch exs + +-- | Chunk a 'TaggedSentence' that has been produced by a Chatter +-- tagger, producing a rich representation of the Chunks and the Tags +-- detected. +-- +-- If you just want to see chunked output from standard text, you +-- probably want 'chunkText' or 'chunkStr'. +chunk :: (ChunkTag c, Tag t) => Chunker c t -> [TaggedSentence t] -> [ChunkedSentence c t] +chunk chk input = chChunker chk input + + +-- | Convenience funciton to Tokenize, POS-tag, then Chunk the +-- provided text, and format the result in an easy-to-read format. +-- +-- > > tgr <- defaultTagger +-- > > chk <- defaultChunker +-- > > chunkText tgr chk "The brown dog jumped over the lazy cat." +-- > "[NP The/DT brown/NN dog/NN] [VP jumped/VBD] [NP over/IN the/DT lazy/JJ cat/NN] ./." +-- +chunkText :: (ChunkTag c, Tag t) => POSTagger t -> Chunker c t -> Text -> Text +chunkText tgr chk input = T.intercalate " " $ map showChunkedSent $ chunk chk $ tag tgr input + + +-- | A wrapper around 'chunkText' that packs strings. +chunkStr :: (ChunkTag c, Tag t) => POSTagger t -> Chunker c t -> String -> String +chunkStr tgr chk str = T.unpack $ chunkText tgr chk $ T.pack str -- | The default table of tagger IDs to readTagger functions. Each -- tagger packaged with Chatter should have an entry here. By diff --git a/src/NLP/Chunk/AvgPerceptronChunker.hs b/src/NLP/Chunk/AvgPerceptronChunker.hs --- a/src/NLP/Chunk/AvgPerceptronChunker.hs +++ b/src/NLP/Chunk/AvgPerceptronChunker.hs @@ -12,9 +12,9 @@ ) where -import NLP.POS.AvgPerceptron ( Perceptron, Feature(..) - , Class(..), predict, update - , averageWeights) +import NLP.ML.AvgPerceptron ( Perceptron, Feature(..) + , Class(..), predict, update + , averageWeights) import NLP.Types import Data.ByteString (ByteString) @@ -196,9 +196,21 @@ , ["pos+nextpos", T.intercalate "+" $ map showPOStag [word, context!!(i+1) ] ] --- , ["tags-since-dt", ""] + , ["tags-since-dt", tagsSinceDt $ take idx tagged] ] + in foldl' add Map.empty features + +tagsSinceDt :: Tag t => [POS t] -> Text +tagsSinceDt posToks = + T.intercalate "-" $ tagsSinceHelper $ reverse posToks + +tagsSinceHelper :: Tag t => [POS t] -> [Text] +tagsSinceHelper [] = [] +tagsSinceHelper (pt@(POS t _):ts) + | isDt t = [] + | otherwise = [ (showPOStag pt) ] ++ (tagsSinceHelper ts) + mkFeature :: Text -> Feature mkFeature txt = Feat $ T.copy txt diff --git a/src/NLP/Corpora/Brown.hs b/src/NLP/Corpora/Brown.hs --- a/src/NLP/Corpora/Brown.hs +++ b/src/NLP/Corpora/Brown.hs @@ -49,6 +49,8 @@ startTag = START endTag = END + isDt tag = tag `elem` [DT, DTdollar, DT_pl_BEZ, DT_pl_MD, DTI, DTS, DTS_pl_BEZ, DTX] + instance Arbitrary Tag where arbitrary = elements [minBound ..] diff --git a/src/NLP/Corpora/Conll.hs b/src/NLP/Corpora/Conll.hs --- a/src/NLP/Corpora/Conll.hs +++ b/src/NLP/Corpora/Conll.hs @@ -52,6 +52,8 @@ startTag = START endTag = END + isDt tag = tag `elem` [DT] + instance Arbitrary Tag where arbitrary = elements [minBound ..] @@ -98,6 +100,15 @@ parseChunk txt = toEitherErr $ readEither $ T.unpack txt notChunk = O +-- | These tags may actually be the Penn Treebank tags. But I have +-- not (yet?) seen the punctuation tags added to the Penn set. +-- +-- This particular list was complied from the union of: +-- +-- * All tags used on the Conll2000 training corpus. (contributing the punctuation tags) +-- * The PennTreebank tags, listed here: (which contributed LS over the items in the corpus). +-- * The tags: START, END, and Unk, which are used by Chatter. +-- data Tag = START -- ^ START tag, used in training. | END -- ^ END tag, used in training. | Hash -- ^ # @@ -109,40 +120,42 @@ | Comma -- ^ , | Term -- ^ . Sentence Terminator | Colon -- ^ : - | CC - | CD - | DT - | EX - | FW - | IN - | JJ - | JJR - | JJS - | MD - | NN - | NNP - | NNPS - | NNS - | PDT - | POS - | PRP - | PRPdollar - | RB - | RBR - | RBS - | RP - | SYM - | TO - | UH - | VB - | VBD - | VBG - | VBN - | VBP - | VBZ - | WDT - | WP - | WPdollar - | WRB + | CC -- ^ Coordinating conjunction + | CD -- ^ Cardinal number + | DT -- ^ Determiner + | EX -- ^ Existential there + | FW -- ^ Foreign word + | IN -- ^ Preposition or subordinating conjunction + | JJ -- ^ Adjective + | JJR -- ^ Adjective, comparative + | JJS -- ^ Adjective, superlative + | LS -- ^ List item marker + | MD -- ^ Modal + | NN -- ^ Noun, singular or mass + | NNS -- ^ Noun, plural + | NNP -- ^ Proper noun, singular + | NNPS -- ^ Proper noun, plural + | PDT -- ^ Predeterminer + | POS -- ^ Possessive ending + | PRP -- ^ Personal pronoun + | PRPdollar -- ^ Possessive pronoun + | RB -- ^ Adverb + | RBR -- ^ Adverb, comparative + | RBS -- ^ Adverb, superlative + | RP -- ^ Particle + | SYM -- ^ Symbol + | TO -- ^ to + | UH -- ^ Interjection + | VB -- ^ Verb, base form + | VBD -- ^ Verb, past tense + | VBG -- ^ Verb, gerund or present participle + | VBN -- ^ Verb, past participle + | VBP -- ^ Verb, non-3rd person singular present + | VBZ -- ^ Verb, 3rd person singular present + | WDT -- ^ Wh-determiner + | WP -- ^ Wh-pronoun + | WPdollar -- ^ Possessive wh-pronoun + | WRB -- ^ Wh-adverb | Unk deriving (Read, Show, Ord, Eq, Generic, Enum, Bounded) + diff --git a/src/NLP/Extraction/Parsec.hs b/src/NLP/Extraction/Parsec.hs --- a/src/NLP/Extraction/Parsec.hs +++ b/src/NLP/Extraction/Parsec.hs @@ -35,7 +35,7 @@ import Text.Parsec.Pos (newPos) import NLP.Types (TaggedSentence(..), Tag(..), CaseSensitive(..), - POS(..), Token(..)) + POS(..), Token(..), ChunkedSentence(..), ChunkOr(..), ChunkTag) instance (Monad m, Tag t) => Stream (TaggedSentence t) m (POS t) where uncons (TaggedSent ts) = do @@ -43,6 +43,14 @@ case mRes of Nothing -> return $ Nothing Just (mTok, rest) -> return $ Just (mTok, TaggedSent rest) + {-# INLINE uncons #-} + +instance (Monad m, ChunkTag c, Tag t) => Stream (ChunkedSentence c t) m (ChunkOr c t) where + uncons (ChunkedSent ts) = do + mRes <- uncons ts + case mRes of + Nothing -> return $ Nothing + Just (mTok, rest) -> return $ Just (mTok, ChunkedSent rest) {-# INLINE uncons #-} -- | A Parsec parser. diff --git a/src/NLP/ML/AvgPerceptron.hs b/src/NLP/ML/AvgPerceptron.hs new file mode 100644 --- /dev/null +++ b/src/NLP/ML/AvgPerceptron.hs @@ -0,0 +1,269 @@ +{-# LANGUAGE DeriveGeneric #-} +-- | Average Perceptron implementation of Part of speech tagging, +-- adapted for Haskell from this python implementation, which is described on the blog post: +-- +-- * +-- +-- The Perceptron code can be found on github: +-- +-- * +-- +module NLP.ML.AvgPerceptron + ( Perceptron(..) + , Class(..) + , Weight + , Feature(..) + , emptyPerceptron + , predict + , train + , update + , averageWeights + ) +where + +import Control.DeepSeq (NFData) +import Data.List (foldl') +import qualified Data.Map.Strict as Map +import Data.Map.Strict (Map) +import Data.Maybe (fromMaybe) +import Data.Serialize (Serialize) +import Data.Text (Text) +import System.Random.Shuffle (shuffleM) +import GHC.Generics + +import NLP.Types () + +newtype Feature = Feat Text + deriving (Read, Show, Eq, Ord, Generic) + +instance Serialize Feature + +-- | The classes that the perceptron assigns are represnted with a +-- newtype-wrapped String. +-- +-- Eventually, I think this should become a typeclass, so the classes +-- can be defined by the users of the Perceptron (such as custom POS +-- tag ADTs, or more complex classes). +newtype Class = Class String + deriving (Read, Show, Eq, Ord, Generic) + +instance Serialize Class + +-- | Typedef for doubles to make the code easier to read, and to make +-- this simple to change if necessary. +type Weight = Double + +infinity :: Weight +infinity = recip 0 + +-- | An empty perceptron, used to start training. +emptyPerceptron :: Perceptron +emptyPerceptron = Perceptron { weights = Map.empty + , totals = Map.empty + , tstamps = Map.empty + , instances = 0 } + +-- | The perceptron model. +data Perceptron = Perceptron { + -- | Each feature gets its own weight vector, so weights is a + -- dict-of-dicts + weights :: Map Feature (Map Class Weight) + + -- | The accumulated values, for the averaging. These will be + -- keyed by feature/clas tuples + , totals :: Map (Feature, Class) Weight + + -- | The last time the feature was changed, for the averaging. Also + -- keyed by feature/clas tuples + -- (tstamps is short for timestamps) + , tstamps :: Map (Feature, Class) Int + + -- | Number of instances seen + , instances :: Int + } deriving (Read, Show, Eq, Generic) + +instance Serialize Perceptron +instance NFData Perceptron + +incrementInstances :: Perceptron -> Perceptron +incrementInstances p = p { instances = 1 + (instances p) } + +getTimestamp :: Perceptron -> (Feature, Class) -> Int +getTimestamp p param = Map.findWithDefault 0 param (tstamps p) + +getTotal :: Perceptron -> (Feature, Class) -> Weight +getTotal p param = Map.findWithDefault 0 param (totals p) + +getFeatureWeight :: Perceptron -> Feature -> Map Class Weight +getFeatureWeight p f = Map.findWithDefault Map.empty f (weights p) + +-- | Predict a class given a feature vector. +-- +-- Ported from python: +-- +-- > def predict(self, features): +-- > '''Dot-product the features and current weights and return the best label.''' +-- > scores = defaultdict(float) +-- > for feat, value in features.items(): +-- > if feat not in self.weights or value == 0: +-- > continue +-- > weights = self.weights[feat] +-- > for label, weight in weights.items(): +-- > scores[label] += value * weight +-- > # Do a secondary alphabetic sort, for stability +-- > return max(self.classes, key=lambda label: (scores[label], label)) +-- +predict :: Perceptron -> Map Feature Int -> Maybe Class +predict per features = -- find highest ranked score in finalScores: + -- trace ("features: "++ show features ++ "\n") $ + -- trace ("finalScores: "++ show sortedScores ++ "\n") $ + sortedScores + where + sortedScores :: Maybe Class + sortedScores = fst $ Map.foldlWithKey ranker (Nothing, negate infinity) finalScores + + ranker r@(_, ow) nc nw | nw > ow = (Just nc, nw) + | otherwise = r + + finalScores :: Map Class Weight + finalScores = Map.foldlWithKey fn Map.empty features + + fn :: Map Class Weight -> Feature -> Int -> Map Class Weight + fn scores f v + | v > 0 = case Map.lookup f (weights per) of + Just vec -> Map.foldlWithKey (doProd v) scores vec + Nothing -> scores + | otherwise = scores + + doProd :: Int -> Map Class Weight -> Class -> Weight -> Map Class Weight + doProd value scores label weight = + Map.alter (updater (weight * (fromIntegral value))) label scores + + updater :: Weight -> Maybe Weight -> Maybe Weight + updater newVal Nothing = Just newVal + updater newVal (Just v) = Just (v + newVal) + +-- | Update the perceptron with a new example. +-- +-- > update(self, truth, guess, features) +-- > ... +-- > self.i += 1 +-- > if truth == guess: +-- > return None +-- > for f in features: +-- > weights = self.weights.setdefault(f, {}) -- setdefault is Map.findWithDefault, and destructive. +-- > upd_feat(truth, f, weights.get(truth, 0.0), 1.0) +-- > upd_feat(guess, f, weights.get(guess, 0.0), -1.0) +-- > return None +-- +update :: Perceptron -> Class -> Class -> [Feature] -> Perceptron +update per truth guess features + | truth == guess = incrementInstances per + | otherwise = foldr loopBody per features + where + loopBody :: Feature -> Perceptron -> Perceptron + loopBody f p = let + fweights = getFeatureWeight p f + cweight c = Map.findWithDefault 0 c fweights + in upd_feat guess f (cweight guess) (-1) + (upd_feat truth f (cweight truth) 1 p) + +-- | ported from python: +-- +-- > def update(self, truth, guess, features): +-- > '''Update the feature weights.''' +-- > def upd_feat(c, f, w, v): +-- > param = (f, c) +-- > self._totals[param] += (self.i - self._tstamps[param]) * w +-- > self._tstamps[param] = self.i +-- > self.weights[f][c] = w + v +upd_feat :: Class -> Feature -> Weight -> Weight -> Perceptron -> Perceptron +upd_feat c f w v p = let + newInstances = 1 + (instances p) -- increment the instance counter. + + -- self._totals[param] += (self.i - self._tstamps[param]) * w + paramTstamp = newInstances - getTimestamp p (f, c) + tmpTotal = (getTotal p (f, c)) + ((fromIntegral paramTstamp) * w) + newTotals = Map.insert (f, c) tmpTotal (totals p) + + -- self._tstamps[param] = self.i + newTstamps = Map.insert (f, c) newInstances (tstamps p) + + -- self.weights[f][c] = w + v + newWeights = Map.insert f (Map.insert c (w + v) (getFeatureWeight p f)) (weights p) + + in p { totals = newTotals + , tstamps = newTstamps + , weights = newWeights } + + +-- | Average the weights +-- +-- Ported from Python: +-- +-- > def average_weights(self): +-- > for feat, weights in self.weights.items(): +-- > new_feat_weights = {} +-- > for clas, weight in weights.items(): +-- > param = (feat, clas) +-- > total = self._totals[param] +-- > total += (self.i - self._tstamps[param]) * weight +-- > averaged = round(total / float(self.i), 3) +-- > if averaged: +-- > new_feat_weights[clas] = averaged +-- > self.weights[feat] = new_feat_weights +-- > return None +-- +averageWeights :: Perceptron -> Perceptron +averageWeights per | (instances per) == 0 = per + | otherwise = per { weights = Map.mapWithKey avgWeights $ weights per + , tstamps = Map.mapWithKey (\_ _->0) (tstamps per) + , instances = 0 } + where + avgWeights :: Feature -> Map Class Weight -> Map Class Weight + avgWeights feat ws = Map.foldlWithKey (doAvg feat) Map.empty ws + + doAvg :: Feature -> Map Class Weight -> Class -> Weight -> Map Class Weight + doAvg f acc c w = let + param = (f, c) + paramTotal = instances per - getTimestamp per param + + total :: Weight + total = (getTotal per param) + ((fromIntegral paramTotal) * w) + averaged = roundTo 3 (total / (fromIntegral $ instances per)) + in if 0 == averaged + then acc + else Map.insert c averaged acc + +-- | round a fractional number to a specified decimal place. +-- +-- >>> roundTo 2 3.1459 +-- 3.15 +-- +roundTo :: RealFrac a => Int -> a -> a +roundTo n f = (fromInteger $ round $ f * (10^n)) / (10.0^^n) + + +-- Train a perceptron +-- +-- Ported from Python: +-- > def train(nr_iter, examples): +-- > model = Perceptron() +-- > for i in range(nr_iter): +-- > random.shuffle(examples) +-- > for features, class_ in examples: +-- > scores = model.predict(features) +-- > guess, score = max(scores.items(), key=lambda i: i[1]) +-- > if guess != class_: +-- > model.update(class_, guess, features) +-- > model.average_weights() +-- > return model +train :: Int -> Perceptron -> [(Map Feature Int, Class)] -> IO Perceptron +train itr model exs = do + trainingSet <- shuffleM $ concat $ take itr $ repeat exs + return $ averageWeights $ foldl' trainEx model trainingSet + +trainEx :: Perceptron -> (Map Feature Int, Class) -> Perceptron +trainEx model (feats, truth) = let + guess = fromMaybe (Class "Unk") $ predict model feats + in update model truth guess $ Map.keys feats diff --git a/src/NLP/POS/AvgPerceptron.hs b/src/NLP/POS/AvgPerceptron.hs deleted file mode 100644 --- a/src/NLP/POS/AvgPerceptron.hs +++ /dev/null @@ -1,269 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} --- | Average Perceptron implementation of Part of speech tagging, --- adapted for Haskell from this python implementation, which is described on the blog post: --- --- * --- --- The Perceptron code can be found on github: --- --- * --- -module NLP.POS.AvgPerceptron - ( Perceptron(..) - , Class(..) - , Weight - , Feature(..) - , emptyPerceptron - , predict - , train - , update - , averageWeights - ) -where - -import Control.DeepSeq (NFData) -import Data.List (foldl') -import qualified Data.Map.Strict as Map -import Data.Map.Strict (Map) -import Data.Maybe (fromMaybe) -import Data.Serialize (Serialize) -import Data.Text (Text) -import System.Random.Shuffle (shuffleM) -import GHC.Generics - -import NLP.Types () - -newtype Feature = Feat Text - deriving (Read, Show, Eq, Ord, Generic) - -instance Serialize Feature - --- | The classes that the perceptron assigns are represnted with a --- newtype-wrapped String. --- --- Eventually, I think this should become a typeclass, so the classes --- can be defined by the users of the Perceptron (such as custom POS --- tag ADTs, or more complex classes). -newtype Class = Class String - deriving (Read, Show, Eq, Ord, Generic) - -instance Serialize Class - --- | Typedef for doubles to make the code easier to read, and to make --- this simple to change if necessary. -type Weight = Double - -infinity :: Weight -infinity = recip 0 - --- | An empty perceptron, used to start training. -emptyPerceptron :: Perceptron -emptyPerceptron = Perceptron { weights = Map.empty - , totals = Map.empty - , tstamps = Map.empty - , instances = 0 } - --- | The perceptron model. -data Perceptron = Perceptron { - -- | Each feature gets its own weight vector, so weights is a - -- dict-of-dicts - weights :: Map Feature (Map Class Weight) - - -- | The accumulated values, for the averaging. These will be - -- keyed by feature/clas tuples - , totals :: Map (Feature, Class) Weight - - -- | The last time the feature was changed, for the averaging. Also - -- keyed by feature/clas tuples - -- (tstamps is short for timestamps) - , tstamps :: Map (Feature, Class) Int - - -- | Number of instances seen - , instances :: Int - } deriving (Read, Show, Eq, Generic) - -instance Serialize Perceptron -instance NFData Perceptron - -incrementInstances :: Perceptron -> Perceptron -incrementInstances p = p { instances = 1 + (instances p) } - -getTimestamp :: Perceptron -> (Feature, Class) -> Int -getTimestamp p param = Map.findWithDefault 0 param (tstamps p) - -getTotal :: Perceptron -> (Feature, Class) -> Weight -getTotal p param = Map.findWithDefault 0 param (totals p) - -getFeatureWeight :: Perceptron -> Feature -> Map Class Weight -getFeatureWeight p f = Map.findWithDefault Map.empty f (weights p) - --- | Predict a class given a feature vector. --- --- Ported from python: --- --- > def predict(self, features): --- > '''Dot-product the features and current weights and return the best label.''' --- > scores = defaultdict(float) --- > for feat, value in features.items(): --- > if feat not in self.weights or value == 0: --- > continue --- > weights = self.weights[feat] --- > for label, weight in weights.items(): --- > scores[label] += value * weight --- > # Do a secondary alphabetic sort, for stability --- > return max(self.classes, key=lambda label: (scores[label], label)) --- -predict :: Perceptron -> Map Feature Int -> Maybe Class -predict per features = -- find highest ranked score in finalScores: - -- trace ("features: "++ show features ++ "\n") $ - -- trace ("finalScores: "++ show sortedScores ++ "\n") $ - sortedScores - where - sortedScores :: Maybe Class - sortedScores = fst $ Map.foldlWithKey ranker (Nothing, negate infinity) finalScores - - ranker r@(_, ow) nc nw | nw > ow = (Just nc, nw) - | otherwise = r - - finalScores :: Map Class Weight - finalScores = Map.foldlWithKey fn Map.empty features - - fn :: Map Class Weight -> Feature -> Int -> Map Class Weight - fn scores f v - | v > 0 = case Map.lookup f (weights per) of - Just vec -> Map.foldlWithKey (doProd v) scores vec - Nothing -> scores - | otherwise = scores - - doProd :: Int -> Map Class Weight -> Class -> Weight -> Map Class Weight - doProd value scores label weight = - Map.alter (updater (weight * (fromIntegral value))) label scores - - updater :: Weight -> Maybe Weight -> Maybe Weight - updater newVal Nothing = Just newVal - updater newVal (Just v) = Just (v + newVal) - --- | Update the perceptron with a new example. --- --- > update(self, truth, guess, features) --- > ... --- > self.i += 1 --- > if truth == guess: --- > return None --- > for f in features: --- > weights = self.weights.setdefault(f, {}) -- setdefault is Map.findWithDefault, and destructive. --- > upd_feat(truth, f, weights.get(truth, 0.0), 1.0) --- > upd_feat(guess, f, weights.get(guess, 0.0), -1.0) --- > return None --- -update :: Perceptron -> Class -> Class -> [Feature] -> Perceptron -update per truth guess features - | truth == guess = incrementInstances per - | otherwise = foldr loopBody per features - where - loopBody :: Feature -> Perceptron -> Perceptron - loopBody f p = let - fweights = getFeatureWeight p f - cweight c = Map.findWithDefault 0 c fweights - in upd_feat guess f (cweight guess) (-1) - (upd_feat truth f (cweight truth) 1 p) - --- | ported from python: --- --- > def update(self, truth, guess, features): --- > '''Update the feature weights.''' --- > def upd_feat(c, f, w, v): --- > param = (f, c) --- > self._totals[param] += (self.i - self._tstamps[param]) * w --- > self._tstamps[param] = self.i --- > self.weights[f][c] = w + v -upd_feat :: Class -> Feature -> Weight -> Weight -> Perceptron -> Perceptron -upd_feat c f w v p = let - newInstances = 1 + (instances p) -- increment the instance counter. - - -- self._totals[param] += (self.i - self._tstamps[param]) * w - paramTstamp = newInstances - getTimestamp p (f, c) - tmpTotal = (getTotal p (f, c)) + ((fromIntegral paramTstamp) * w) - newTotals = Map.insert (f, c) tmpTotal (totals p) - - -- self._tstamps[param] = self.i - newTstamps = Map.insert (f, c) newInstances (tstamps p) - - -- self.weights[f][c] = w + v - newWeights = Map.insert f (Map.insert c (w + v) (getFeatureWeight p f)) (weights p) - - in p { totals = newTotals - , tstamps = newTstamps - , weights = newWeights } - - --- | Average the weights --- --- Ported from Python: --- --- > def average_weights(self): --- > for feat, weights in self.weights.items(): --- > new_feat_weights = {} --- > for clas, weight in weights.items(): --- > param = (feat, clas) --- > total = self._totals[param] --- > total += (self.i - self._tstamps[param]) * weight --- > averaged = round(total / float(self.i), 3) --- > if averaged: --- > new_feat_weights[clas] = averaged --- > self.weights[feat] = new_feat_weights --- > return None --- -averageWeights :: Perceptron -> Perceptron -averageWeights per | (instances per) == 0 = per - | otherwise = per { weights = Map.mapWithKey avgWeights $ weights per - , tstamps = Map.mapWithKey (\_ _->0) (tstamps per) - , instances = 0 } - where - avgWeights :: Feature -> Map Class Weight -> Map Class Weight - avgWeights feat ws = Map.foldlWithKey (doAvg feat) Map.empty ws - - doAvg :: Feature -> Map Class Weight -> Class -> Weight -> Map Class Weight - doAvg f acc c w = let - param = (f, c) - paramTotal = instances per - getTimestamp per param - - total :: Weight - total = (getTotal per param) + ((fromIntegral paramTotal) * w) - averaged = roundTo 3 (total / (fromIntegral $ instances per)) - in if 0 == averaged - then acc - else Map.insert c averaged acc - --- | round a fractional number to a specified decimal place. --- --- >>> roundTo 2 3.1459 --- 3.15 --- -roundTo :: RealFrac a => Int -> a -> a -roundTo n f = (fromInteger $ round $ f * (10^n)) / (10.0^^n) - - --- Train a perceptron --- --- Ported from Python: --- > def train(nr_iter, examples): --- > model = Perceptron() --- > for i in range(nr_iter): --- > random.shuffle(examples) --- > for features, class_ in examples: --- > scores = model.predict(features) --- > guess, score = max(scores.items(), key=lambda i: i[1]) --- > if guess != class_: --- > model.update(class_, guess, features) --- > model.average_weights() --- > return model -train :: Int -> Perceptron -> [(Map Feature Int, Class)] -> IO Perceptron -train itr model exs = do - trainingSet <- shuffleM $ concat $ take itr $ repeat exs - return $ averageWeights $ foldl' trainEx model trainingSet - -trainEx :: Perceptron -> (Map Feature Int, Class) -> Perceptron -trainEx model (feats, truth) = let - guess = fromMaybe (Class "Unk") $ predict model feats - in update model truth guess $ Map.keys feats diff --git a/src/NLP/POS/AvgPerceptronTagger.hs b/src/NLP/POS/AvgPerceptronTagger.hs --- a/src/NLP/POS/AvgPerceptronTagger.hs +++ b/src/NLP/POS/AvgPerceptronTagger.hs @@ -20,9 +20,9 @@ where import NLP.Corpora.Parsing (readPOSWith) -import NLP.POS.AvgPerceptron ( Perceptron, Feature(..) - , Class(..), predict, update - , emptyPerceptron, averageWeights) +import NLP.ML.AvgPerceptron ( Perceptron, Feature(..) + , Class(..), predict, update + , emptyPerceptron, averageWeights) import NLP.Types import Control.Monad (foldM) diff --git a/src/NLP/Types/Tags.hs b/src/NLP/Types/Tags.hs --- a/src/NLP/Types/Tags.hs +++ b/src/NLP/Types/Tags.hs @@ -46,6 +46,8 @@ tagTerm :: a -> Text startTag :: a endTag :: a + -- | Check if a tag is a determiner tag. + isDt :: a -> Bool -- | A fall-back 'ChunkTag' instance, analogous to 'RawTag' newtype RawChunk = RawChunk Text @@ -77,6 +79,8 @@ startTag = RawTag "-START-" endTag = RawTag "-END-" + + isDt (RawTag tg) = tg == "DT" instance Arbitrary RawTag where arbitrary = do diff --git a/src/NLP/Types/Tree.hs b/src/NLP/Types/Tree.hs --- a/src/NLP/Types/Tree.hs +++ b/src/NLP/Types/Tree.hs @@ -46,6 +46,16 @@ data Chunk chunk tag = Chunk chunk [ChunkOr chunk tag] deriving (Read, Show, Eq) +showChunkedSent :: (ChunkTag c, Tag t) => ChunkedSentence c t -> Text +showChunkedSent (ChunkedSent cs) = T.intercalate " " (map showChunkOr cs) + where + showChunkOr (POS_CN pos) = printPOS pos + showChunkOr (Chunk_CN (Chunk chunk cors)) = + let front = T.concat ["[", fromChunk chunk] + back = "]" + bits = map showChunkOr cors + in T.append (T.intercalate " " (front:bits)) back + instance (ChunkTag c, Arbitrary c, Arbitrary t, Tag t) => Arbitrary (ChunkedSentence c t) where arbitrary = ChunkedSent <$> arbitrary diff --git a/tests/src/AvgPerceptronTests.hs b/tests/src/AvgPerceptronTests.hs --- a/tests/src/AvgPerceptronTests.hs +++ b/tests/src/AvgPerceptronTests.hs @@ -11,7 +11,7 @@ import Data.Map (Map) import qualified Data.Map as Map -import NLP.POS.AvgPerceptron +import NLP.ML.AvgPerceptron tests :: Test tests = testGroup "AvgPerceptron" diff --git a/tests/src/Main.hs b/tests/src/Main.hs --- a/tests/src/Main.hs +++ b/tests/src/Main.hs @@ -31,6 +31,7 @@ import qualified NLP.Similarity.VectorSimTests as Vec import qualified NLP.TypesTests as TypeTests import qualified NLP.Types.IOBTests as IOB +import qualified NLP.Types.TreeTests as Tree import qualified NLP.Chunk.AvgPerceptronChunkerTests as APC import Corpora @@ -69,6 +70,7 @@ , Conll.tests , IOB.tests , APC.tests + , Tree.tests ]