content: -- | This POS tagger deterministically tags tokens.  However, if it
  -- ever sees multiple tags for the same token, it will forget the tag
  -- it has learned.  This is useful for creating taggers that have very
  -- high precision, but very low recall.
  --
  -- Unambiguous taggers are also useful when defined with a
  -- non-deterministic backoff tagger, such as an
  -- "NLP.POS.AveragedPerceptronTagger", since the high-confidence tags
  -- will be applied first, followed by the more non-deterministic
  -- results of the backoff tagger.
  module NLP.POS.UnambiguousTagger where
  
  import Data.ByteString (ByteString)
  import Data.ByteString.Char8 (pack)
  import Data.Map (Map)
  import qualified Data.Map as Map
  import Data.Serialize (encode, decode)
  import Data.Text (Text)
  
  import NLP.Tokenize.Chatter (tokenize)
  import NLP.Types
  
  import qualified NLP.POS.LiteralTagger as LT
  
  taggerID :: ByteString
  taggerID = pack "NLP.POS.UnambiguousTagger"
  
  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 :: Tag t => Map Text t -> Maybe (POSTagger t) -> POSTagger t
  mkTagger table mTgr = let
    litTagger = LT.mkTagger table LT.Sensitive mTgr
  
  --  trainer :: Tag t => [TaggedSentence t] -> IO (POSTagger t)
    trainer exs = do
      let newTable = train table exs
      return $ mkTagger newTable mTgr
  
    in litTagger { posTrainer = trainer
                 , posSerialize = encode table
                 , posID = taggerID
                 , posTokenizer = tokenize
                 }
  
  -- | Trainer method for unambiguous taggers.
  train :: Tag t => Map Text t -> [TaggedSentence t] -> Map Text t
  train table exs = let
  
  --  pairs :: POS t
    pairs = concatMap unTS exs
  
  --  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
  
  