concraft 0.8.3 → 0.9.0

raw patch · 5 files changed

+109/−46 lines, 5 filesdep ~crf-chain2-tiersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: crf-chain2-tiers

API changes (from Hackage documentation)

Files

• concraft.cabal +2/−2
• src/NLP/Concraft.hs +43/−6
• src/NLP/Concraft/Disamb.hs +54/−31
• src/NLP/Concraft/Guess.hs +8/−6
• src/NLP/Concraft/Morphosyntax.hs +2/−1

@@ -1,5 +1,5 @@ name:               concraft-version:            0.8.3+version:            0.9.0 synopsis:           Morphological disambiguation based on constrained CRFs description:     A morphological disambiguation library based on@@ -36,7 +36,7 @@       , sgd                     >= 0.3.3    && < 0.4       , tagset-positional       >= 0.3      && < 0.4       , crf-chain1-constrained  >= 0.3      && < 0.4-      , crf-chain2-tiers        >= 0.2      && < 0.3+      , crf-chain2-tiers        >= 0.2.1    && < 0.3       , monad-codec             >= 0.2      && < 0.3       , data-lens               >= 2.10     && < 2.11       , transformers            >= 0.2      && < 0.4

@@ -1,5 +1,6 @@ {-# LANGUAGE RecordWildCards #-} + module NLP.Concraft ( -- * Model @@ -9,15 +10,21 @@  -- * Tagging , tag+, marginals  -- * Training , train , reAnaTrain++-- * Pruning+, prune ) where + import           System.IO (hClose) import           Control.Applicative ((<$>), (<*>)) import           Control.Monad (when)+import qualified Data.Set as S import           Data.Binary (Binary, put, get) import qualified Data.Binary as Binary import           Data.Aeson@@ -84,12 +91,30 @@  -- | Tag sentence using the model.  In your code you should probably -- use your analysis function, translate results into a container of--- `Sent`ences, evaluate `tagSent` on each sentence and embed the--- tagging results into morphosyntactic structure of your own.-tag :: Word w => Concraft -> Sent w P.Tag -> [P.Tag]-tag Concraft{..} = D.disamb disamb . G.guessSent guessNum guesser+-- `Sent`ences, evaluate `tag` on each sentence and embed the+-- tagging results into the morphosyntactic structure of your own.+--+-- The function returns guessing results as `fst` elements+-- of the output pairs and disambiguation results as `snd`+-- elements of the corresponding pairs.+tag :: Word w => Concraft -> Sent w P.Tag -> [(S.Set P.Tag, P.Tag)]+tag Concraft{..} sent =+    zip (map S.fromList gss) tgs+  where+    gss = G.guess guessNum guesser sent+    tgs = D.disamb disamb (G.include gss sent)  +-- | Determine marginal probabilities corresponding to individual+-- tags w.r.t. the disambiguation model.  Since the guessing model+-- is used first, the resulting weighted maps may contain tags+-- not present in the input sentence.+marginals :: Word w => Concraft -> Sent w P.Tag -> [WMap P.Tag]+marginals Concraft{..} sent =+    let gss = G.guess guessNum guesser sent+    in  D.marginals disamb (G.include gss sent)++ --------------------- -- Training ---------------------@@ -102,7 +127,7 @@     -> Analyse w P.Tag      -- ^ Analysis function     -> Int                  -- ^ Numer of guessed tags for each word      -> G.TrainConf          -- ^ Guessing model training configuration-    -> D.TrainConf          -- ^ Disambiguation model training configuration+    -> D.TrainConf          -- ^ Disamb model training configuration     -> IO [SentO w P.Tag]   -- ^ Training data     -> IO [SentO w P.Tag]   -- ^ Evaluation data     -> IO Concraft@@ -126,7 +151,7 @@     => P.Tagset             -- ^ Tagset     -> Int                  -- ^ Numer of guessed tags for each word     -> G.TrainConf          -- ^ Guessing model training configuration-    -> D.TrainConf          -- ^ Disambiguation model training configuration+    -> D.TrainConf          -- ^ Disamb model training configuration     -> IO [Sent w P.Tag]    -- ^ Training data     -> IO [Sent w P.Tag]    -- ^ Evaluation data     -> IO Concraft@@ -145,6 +170,18 @@     disamb <- D.train disambConf trainG'IO evalG'IO     return $ Concraft tagset guessNum guesser disamb ++---------------------+-- Pruning+---------------------+++-- | Prune disambiguation model: discard model features with+-- absolute values (in log-domain) lower than the given threshold.+prune :: Double -> Concraft -> Concraft+prune x concraft =+    let disamb' = D.prune x (disamb concraft)+    in  concraft { disamb = disamb' }   ---------------------

@@ -11,6 +11,7 @@ , P.Atom (..)  -- * Disambiguation+, marginals , disamb , include , disambSent@@ -18,11 +19,13 @@ -- * Training , TrainConf (..) , train++-- * Pruning+, prune ) where   import Control.Applicative ((<$>), (<*>))-import Data.Maybe (fromJust) import Data.List (find) import Data.Binary (Binary, put, get) import qualified Data.Set as S@@ -68,7 +71,11 @@ -- | Unsplit the complex tag (assuming, that it is one -- of the interpretations of the word). unSplit :: Eq t => (r -> t) -> X.Seg w r -> t -> r-unSplit split' word x = fromJust $ find ((==x) . split') (X.interps word)+unSplit split' word x = case jy of+    Just y  -> y+    Nothing -> error "unSplit: no such interpretation"+  where+    jy = find ((==x) . split') (X.interps word)   -- | Perform context-sensitive disambiguation.@@ -103,13 +110,40 @@ disambSent = include . disamb  +-- | Tag labels with marginal probabilities.+marginals :: X.Word w => Disamb -> X.Sent w T.Tag -> [X.WMap T.Tag]+marginals Disamb{..} sent+    = map (uncurry embed)+    . zip sent+    . CRF.marginals crf+    . schematize schema+    . X.mapSent split+    $ sent+  where+    schema  = fromConf schemaConf+    split   = P.split tiers+    embed w = X.mkWMap . zip (X.interps w)+++-- | Prune disamb model: discard model features with absolute values+-- (in log-domain) lower than the given threshold.+prune :: Double -> Disamb -> Disamb+prune x dmb =+    let crf' = CRF.prune x (crf dmb)+    in  dmb { crf = crf' }++ -- | Training configuration.-data TrainConf = TrainConf-    { tiersT        :: [P.Tier]-    , schemaConfT   :: SchemaConf-    , sgdArgsT      :: SGD.SgdArgs-    , onDiskT       :: Bool-    , pruneT        :: Maybe Double }+data TrainConf+    = TrainConf+        { tiersT        :: [P.Tier]+        , schemaConfT   :: SchemaConf+        , sgdArgsT      :: SGD.SgdArgs+        , onDiskT       :: Bool }+    | ReTrainConf+        { initDmb       :: Disamb+        , sgdArgsT      :: SGD.SgdArgs+        , onDiskT       :: Bool }   -- | Train disamb model.@@ -120,37 +154,26 @@     -> IO [X.Sent w T.Tag]      -- ^ Evaluation data     -> IO Disamb                -- ^ Resultant model train TrainConf{..} trainData evalData = do--    -- Train first model     crf <- CRF.train (length tiersT) CRF.selectHidden sgdArgsT onDiskT         (schemed schema split <$> trainData)         (schemed schema split <$> evalData)     putStr "\nNumber of features: " >> print (CRF.size crf)--    -- Re-train model if prune parameter is Just-    reCrf <- case pruneT of-        Just th -> do -            putStrLn "\n===== Prune and retrain disambiguation model ====="-            crf' <- CRF.reTrain (CRF.prune th crf)-                (gainMul 0.5 sgdArgsT) onDiskT-                (schemed schema split <$> trainData)-                (schemed schema split <$> evalData)-            putStr "\nNumber of features: " >> print (CRF.size crf')-            return crf'-        Nothing -> return crf--    -- Final disamb model-    return $ Disamb tiersT schemaConfT reCrf-+    return $ Disamb tiersT schemaConfT crf   where-     schema = fromConf schemaConfT     split  = P.split tiersT -    -- Muliply gain0 parameter by the given number.-    gainMul x sgdArgs =-        let gain0' = SGD.gain0 sgdArgs * x-        in  sgdArgs { SGD.gain0 = gain0' }+-- Improve disamb model.+train ReTrainConf{..} trainData evalData = do+    crf' <- CRF.reTrain crf sgdArgsT onDiskT+        (schemed schema split <$> trainData)+        (schemed schema split <$> evalData)+    putStr "\nNumber of features: " >> print (CRF.size crf')+    return $ initDmb { crf = crf' }+  where+    Disamb{..} = initDmb+    schema = fromConf schemaConf+    split  = P.split tiers   -- | Schematized data from the plain file.

@@ -62,7 +62,9 @@         where w = v V.! i  --- | Determine 'k' most probable labels for each word in the sentence.+-- | Determine the 'k' most probable labels for each word in the sentence.+-- TODO: Perhaps it would be better to use sets instead of lists+-- as output? guess :: (X.Word w, Ord t)       => Int -> Guesser t -> X.Sent w t -> [[t]] guess k gsr sent =@@ -71,9 +73,8 @@   -- | Insert guessing results into the sentence.-include :: (X.Word w, Ord t) => (X.Sent w t -> [[t]])-        -> X.Sent w t -> X.Sent w t-include f sent =+include :: (X.Word w, Ord t) => [[t]] -> X.Sent w t -> X.Sent w t+include xss sent =     [ word { X.tags = tags }     | (word, tags) <- zip sent sentTags ]   where@@ -81,7 +82,7 @@         [ if X.oov word             then addInterps (X.tags word) xs             else X.tags word-        | (xs, word) <- zip (f sent) sent ]+        | (xs, word) <- zip xss sent ]     addInterps wm xs = X.mkWMap         $  M.toList (X.unWMap wm)         ++ zip xs [0, 0 ..]@@ -90,7 +91,8 @@ -- | Combine `guess` with `include`.  guessSent :: (X.Word w, Ord t)           => Int -> Guesser t -> X.Sent w t -> X.Sent w t-guessSent guessNum guesser = include (guess guessNum guesser)+guessSent guessNum guesser sent =+    include (guess guessNum guesser sent) sent   -- | Method of constructing the default set of labels (R0).

@@ -34,6 +34,7 @@ import           Control.Applicative ((<$>), (<*>)) import           Control.Arrow (first) import           Data.Aeson+import           Data.Binary (Binary) import qualified Data.Set as S import qualified Data.Map as M import qualified Data.Text as T@@ -134,7 +135,7 @@ -- | A set with a non-negative weight assigned to each of -- its elements. newtype WMap a = WMap { unWMap :: M.Map a Double }-    deriving (Show, Eq, Ord)+    deriving (Show, Eq, Ord, Binary)   -- | Make a weighted collection.  Negative elements will be ignored.