concraft 0.13.0 → 0.14.0

raw patch · 4 files changed

+90/−63 lines, 4 filesdep ~crf-chain2-tiersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: crf-chain2-tiers

API changes (from Hackage documentation)

Files

• changelog +6/−0
• concraft.cabal +2/−2
• src/NLP/Concraft/DAG/DisambSeg.hs +62/−11
• src/NLP/Concraft/DAGSeg.hs +20/−50

@@ -1,4 +1,10 @@ -*-change-log-*- +0.14.0	Oct 2018+	* Rely on `fastTag` from the `crf-chain2-tiers` library++0.13.0	Sep 2018+	* Slightly optimize guessing+ 0.12.0	Sep 2018 	* Add support for a tag blacklist (guessing)

@@ -1,5 +1,5 @@ name:               concraft-version:            0.13.0+version:            0.14.0 synopsis:           Morphological disambiguation based on constrained CRFs description:     A morphological disambiguation library based on@@ -38,7 +38,7 @@       , sgd                     >= 0.4.0    && < 0.5       , tagset-positional       >= 0.3      && < 0.4       , crf-chain1-constrained  >= 0.5      && < 0.6-      , crf-chain2-tiers        >= 0.3      && < 0.4+      , crf-chain2-tiers        >= 0.4      && < 0.5       , monad-codec             >= 0.2      && < 0.3       , data-lens               >= 2.10     && < 2.12       , transformers            >= 0.2      && < 0.6

@@ -19,6 +19,10 @@ , P.Tier (..) , P.Atom (..) ++-- * Disambiguation+, disamb+ -- -- * Marginals -- , marginalsSent -- , marginals@@ -39,11 +43,13 @@  import Prelude hiding (words) import Control.Applicative ((<$>), (<*>), pure)+import Control.Monad (guard) import Data.Binary (put, get, Put, Get)+import Data.Maybe (maybeToList) import Data.Text.Binary () -- import System.Console.CmdArgs import qualified Data.Set as S-import qualified Data.Map as M+import qualified Data.Map.Strict as M -- import qualified Data.Vector as V -- import qualified Data.List as List @@ -111,8 +117,8 @@ --------------------------  --- | Replace the probabilities of the sentence labels with the new probabilities--- stemming from the CRF sentence.+-- | Replace the probabilities of the sentence labels with the new+-- probabilities stemming from the CRF sentence. inject   :: (Ord t, X.Word w)   => Disamb t@@ -152,7 +158,6 @@   -- | Determine the marginal probabilities of to individual labels in the sentence.--- marginalsSent :: (X.Word w, Ord t) => Disamb t -> X.Sent w t -> DAG () (X.WMap [P.Atom]) probsSent :: (X.Word w, Ord t) => CRF.ProbType -> Disamb t -> X.Sent w t -> X.Sent w t probsSent probTyp dmb sent   = (\new -> inject dmb new sent)@@ -160,20 +165,66 @@   . probsCRF probTyp dmb   $ sent   where-    getTags = X.mkWMap . M.toList . choice -- CRF.unProb . snd+    -- getTags = X.mkWMap . M.toList . choice+    getTags = X.fromMap . choice     -- below we mix the chosen and the potential interpretations together     choice w = M.unionWith (+)       (CRF.unProb . snd $ w)-      (M.fromList . map (,0) . interps $ w)-    interps = S.toList . CRF.lbs . fst--+      -- (M.fromList . map (,0) . interps $ w)+      (M.fromSet (const 0) . interps $ w)+    -- interps = S.toList . CRF.lbs . fst+    interps = CRF.lbs . fst  --- | Ascertain the marginal probabilities of the individual labels in the sentence.-probsCRF :: (X.Word w, Ord t) => CRF.ProbType -> Disamb t -> X.Sent w t -> CRF.SentL Ob P.Atom+-- | Determine the marginal probabilities of the individual labels in the sentence.+probsCRF ::+     (X.Word w, Ord t)+  => CRF.ProbType+  -> Disamb t+  -> X.Sent w t+  -> CRF.SentL Ob P.Atom probsCRF probTyp dmb   = CRF.probs probTyp (crf dmb)+  . schematize schema+  . X.mapSent (split (tiers dmb) . simplify dmb)+  where+    schema = fromConf (schemaConf dmb)+++--------------------------+-- Disambiguation+--------------------------+++-- -- | Perform disambiguation.+-- disamb :: (X.Word w, Ord t) => Disamb t -> X.Sent w t -> DAG () (X.WMap t)+-- disamb probTyp dmb = fmap X.tags . probsSent probTyp dmb+++-- | Perform disambiguation.+disamb :: (X.Word w, Ord t) => Disamb t -> X.Sent w t -> DAG () (M.Map t Bool)+disamb dmb srcSent+  = injectDmb+  . disambCRF dmb+  $ srcSent+  where+    injectDmb newSent =+      let doit (target, src) = M.fromList $ do+            tag <- X.interps src+            let tag' = split (tiers dmb) (simplify dmb tag)+                isDmb = Just tag' == target+            return (tag, isDmb)+      in  fmap doit (DAG.zipE newSent srcSent)+++-- | Perform disambiguation (CRF level).+disambCRF ::+     (X.Word w, Ord t)+  => Disamb t+  -> X.Sent w t+  -> DAG () (Maybe [P.Atom])+disambCRF dmb+  = CRF.tag (crf dmb)   . schematize schema   . X.mapSent (split (tiers dmb) . simplify dmb)   where

@@ -15,7 +15,8 @@ -- * Annotation , Anno --- * Best paths+-- * Disambiguation / best paths+, disamb , findOptimalPaths , disambPath @@ -89,7 +90,7 @@   , guessNum      :: Int   , guesser       :: G.Guesser t P.Tag   , segmenter     :: D.Disamb t-  , disamb        :: D.Disamb t+  , disamber        :: D.Disamb t   }  @@ -100,7 +101,7 @@   put guessNum   G.putGuesser guesser   D.putDisamb segmenter-  D.putDisamb disamb+  D.putDisamb disamber   -- | Get the model, given the tag simplification function for the disambigutation model.@@ -190,33 +191,10 @@   ------------------------- Best path+-- Disambiguation ----------------------  --- -- | Find all optimal paths in the given annotation. Optimal paths are those--- -- which go through tags with the assigned probability 1.--- findOptimalPaths :: Anno t Double -> [[(EdgeID, t)]]--- findOptimalPaths dag = do---   edgeID <- DAG.dagEdges dag---   guard $ DAG.isInitialEdge edgeID dag---   doit edgeID---   where---     doit i = inside i ++ final i---     inside i = do---       (tag, weight) <- M.toList (DAG.edgeLabel i dag)---       guard $ weight >= 1.0 - eps---       j <- DAG.nextEdges i dag---       xs <- doit j---       return $ (i, tag) : xs---     final i = do---       guard $ DAG.isFinalEdge i dag---       (tag, weight) <- M.toList (DAG.edgeLabel i dag)---       guard $ weight >= 1.0 - eps---       return [(i, tag)]---     eps = 1.0e-9-- -- | Find all optimal paths in the given annotation. Optimal paths are those -- which go through tags with the assigned probability 1. For a given chosen -- edge, all the tags with probability 1 are selected.@@ -247,19 +225,6 @@     eps = 1.0e-9  --- -- | Make the given path with disamb markers in the given annotation--- -- and produce a new disamb annotation.--- disambPath :: (Ord t) => [(EdgeID, t)] -> Anno t Double -> Anno t Bool--- disambPath path =---   DAG.mapE doit---   where---     pathMap = M.fromList path---     doit edgeID m = M.fromList $ do---       let onPath = M.lookup edgeID pathMap---       x <- M.keys m---       return (x, Just x == onPath)-- -- | Make the given path with disamb markers in the given annotation -- and produce a new disamb annotation. disambPath :: (Ord t) => [(EdgeID, S.Set t)] -> Anno t Double -> Anno t Bool@@ -273,13 +238,19 @@       return (x, S.member x onPath)  +-- | Determine max probabilities corresponding to individual tags w.r.t. the+-- disambiguation model.+disamb :: (X.Word w, Ord t) => D.Disamb t -> Sent w t -> Anno t Bool+disamb dmb = D.disamb dmb++ ---------------------- -- Marginals and Probs ----------------------  --- | Determine marginal probabilities corresponding to individual--- tags w.r.t. the guessing model.+-- | Determine marginal probabilities corresponding to individual tags w.r.t.+-- the guessing model. guessMarginals   :: (X.Word w, Ord t)   => CRF.Config P.Tag@@ -289,15 +260,14 @@ guessMarginals cfg gsr = fmap X.unWMap . G.marginals cfg gsr  --- | Determine marginal probabilities corresponding to individual--- tags w.r.t. the guessing model.+-- | Determine marginal probabilities corresponding to individual tags w.r.t.+-- the disambiguation model. disambMarginals :: (X.Word w, Ord t) => D.Disamb t -> Sent w t -> Anno t Double--- disambMarginals dmb = fmap X.unWMap . D.marginals dmb disambMarginals = disambProbs D.Marginals  --- | Determine probabilities corresponding to individual--- tags w.r.t. the guessing model.+-- | Determine max probabilities corresponding to individual tags w.r.t. the+-- disambiguation model. disambProbs :: (X.Word w, Ord t) => D.ProbType -> D.Disamb t -> Sent w t -> Anno t Double disambProbs typ dmb = fmap X.unWMap . D.probs typ dmb @@ -374,7 +344,7 @@   -> Concraft t   -> Sent w t   -> Anno t Double-tag k cfg crf = disambMarginals (disamb crf) . guessSent k cfg (guesser crf)+tag k cfg crf = disambMarginals (disamber crf) . guessSent k cfg (guesser crf)   ---------------------@@ -462,5 +432,5 @@ -- (in log-domain) lower than the given threshold. prune :: Double -> Concraft t -> Concraft t prune x concraft =-    let disamb' = D.prune x (disamb concraft)-    in  concraft { disamb = disamb' }+    let disamber' = D.prune x (disamber concraft)+    in  concraft { disamber = disamber' }