packages feed

concraft 0.11.0 → 0.12.0

raw patch · 12 files changed

+110/−432 lines, 12 filesdep ~crf-chain1-constrainedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: crf-chain1-constrained

API changes (from Hackage documentation)

- NLP.Concraft.DAG2: Concraft :: Tagset -> Int -> Guesser t Tag -> Disamb t -> Concraft t
- NLP.Concraft.DAG2: [disamb] :: Concraft t -> Disamb t
- NLP.Concraft.DAG2: [guessNum] :: Concraft t -> Int
- NLP.Concraft.DAG2: [guesser] :: Concraft t -> Guesser t Tag
- NLP.Concraft.DAG2: [tagset] :: Concraft t -> Tagset
- NLP.Concraft.DAG2: data Concraft t
- NLP.Concraft.DAG2: disambMarginals :: (Word w, Ord t) => Disamb t -> Sent w t -> Anno t Double
- NLP.Concraft.DAG2: disambPath :: (Ord t) => [(EdgeID, t)] -> Anno t Double -> Anno t Bool
- NLP.Concraft.DAG2: disambProbs :: (Word w, Ord t) => ProbType -> Disamb t -> Sent w t -> Anno t Double
- NLP.Concraft.DAG2: findOptimalPaths :: Anno t Double -> [[(EdgeID, t)]]
- NLP.Concraft.DAG2: guess :: (Word w, Ord t) => Int -> Guesser t Tag -> Sent w t -> Anno t Double
- NLP.Concraft.DAG2: guessMarginals :: (Word w, Ord t) => Guesser t Tag -> Sent w t -> Anno t Double
- NLP.Concraft.DAG2: guessSent :: (Word w, Ord t) => Int -> Guesser t Tag -> Sent w t -> Sent w t
- NLP.Concraft.DAG2: loadModel :: (Ord t, Binary t) => (Tagset -> t -> Tag) -> FilePath -> IO (Concraft t)
- NLP.Concraft.DAG2: prune :: Double -> Concraft t -> Concraft t
- NLP.Concraft.DAG2: replace :: (Ord t) => Anno t Double -> Sent w t -> Sent w t
- NLP.Concraft.DAG2: saveModel :: (Ord t, Binary t) => FilePath -> Concraft t -> IO ()
- NLP.Concraft.DAG2: tag :: (Word w, Ord t) => Int -> Concraft t -> Sent w t -> Anno t Double
- NLP.Concraft.DAG2: train :: (Word w, Ord t) => Tagset -> Int -> TrainConf t Tag -> TrainConf t -> IO [Sent w t] -> IO [Sent w t] -> IO (Concraft t)
- NLP.Concraft.DAG2: type Anno a b = DAG () (Map a b)
- NLP.Concraft.DAG.Guess: marginals :: (Word w, Ord t, Ord s) => Guesser t s -> Sent w t -> DAG () (WMap t)
+ NLP.Concraft.DAG.Guess: marginals :: (Word w, Ord t, Ord s) => Config s -> Guesser t s -> Sent w t -> DAG () (WMap t)
- NLP.Concraft.DAG.Guess: marginalsSent :: (Word w, Ord t, Ord s) => Guesser t s -> Sent w t -> Sent w t
+ NLP.Concraft.DAG.Guess: marginalsSent :: (Word w, Ord t, Ord s) => Config s -> Guesser t s -> Sent w t -> Sent w t
- NLP.Concraft.DAGSeg: guess :: (Word w, Ord t) => Int -> Guesser t Tag -> Sent w t -> Anno t Double
+ NLP.Concraft.DAGSeg: guess :: (Word w, Ord t) => Int -> Config Tag -> Guesser t Tag -> Sent w t -> Anno t Double
- NLP.Concraft.DAGSeg: guessMarginals :: (Word w, Ord t) => Guesser t Tag -> Sent w t -> Anno t Double
+ NLP.Concraft.DAGSeg: guessMarginals :: (Word w, Ord t) => Config Tag -> Guesser t Tag -> Sent w t -> Anno t Double
- NLP.Concraft.DAGSeg: guessSent :: (Word w, Ord t) => Int -> Guesser t Tag -> Sent w t -> Sent w t
+ NLP.Concraft.DAGSeg: guessSent :: (Word w, Ord t) => Int -> Config Tag -> Guesser t Tag -> Sent w t -> Sent w t
- NLP.Concraft.DAGSeg: tag :: (Word w, Ord t) => Int -> Concraft t -> Sent w t -> Anno t Double
+ NLP.Concraft.DAGSeg: tag :: (Word w, Ord t) => Int -> Config Tag -> Concraft t -> Sent w t -> Anno t Double

Files

+ changelog view
@@ -0,0 +1,4 @@+-*-change-log-*-++0.12.0	Sep 2018+	* Add support for a tag blacklist (guessing)
concraft.cabal view
@@ -1,5 +1,5 @@ name:               concraft-version:            0.11.0+version:            0.12.0 synopsis:           Morphological disambiguation based on constrained CRFs description:     A morphological disambiguation library based on@@ -15,6 +15,8 @@ homepage:           http://zil.ipipan.waw.pl/Concraft build-type:         Simple +extra-source-files: changelog+ Flag buildAnaTool     Description: Build model analysis tool     Default:     False@@ -35,7 +37,7 @@       , monad-ox                >= 0.3      && < 0.4       , sgd                     >= 0.4.0    && < 0.5       , tagset-positional       >= 0.3      && < 0.4-      , crf-chain1-constrained  >= 0.4      && < 0.5+      , crf-chain1-constrained  >= 0.5      && < 0.6       , crf-chain2-tiers        >= 0.3      && < 0.4       , monad-codec             >= 0.2      && < 0.3       , data-lens               >= 2.10     && < 2.12@@ -69,7 +71,7 @@       , NLP.Concraft.DAG.Disamb       , NLP.Concraft.DAG.DisambSeg       -- , NLP.Concraft.DAG-      , NLP.Concraft.DAG2+      -- , NLP.Concraft.DAG2       , NLP.Concraft.DAGSeg      other-modules:
src/NLP/Concraft.hs view
@@ -35,7 +35,7 @@  import           NLP.Concraft.Morphosyntax import           NLP.Concraft.Analysis-import           NLP.Concraft.Format.Temp+-- import           NLP.Concraft.Format.Temp import qualified Data.Tagset.Positional as P import qualified NLP.Concraft.Guess as G import qualified NLP.Concraft.Disamb as D@@ -230,10 +230,10 @@     -> IO a withTemp _      _   _    [] handler = handler (return []) withTemp tagset dir tmpl xs handler =-  Temp.withTempFile dir tmpl $ \tmpPath tmpHandle -> do+  Temp.withTempFile dir tmpl $ \_tmpPath tmpHandle -> do     hClose tmpHandle-    let txtSent = mapSent $ P.showTag tagset-        tagSent = mapSent $ P.parseTag tagset+    let _txtSent = mapSent $ P.showTag tagset+        _tagSent = mapSent $ P.parseTag tagset     -- writePar tmpPath $ map txtSent xs     -- handler (map tagSent <$> readPar tmpPath)     handler (return xs)
src/NLP/Concraft/DAG/Disamb.hs view
@@ -37,13 +37,13 @@  import Prelude hiding (words) import Control.Applicative ((<$>), (<*>), pure)-import Data.Binary (Binary, put, get, Put, Get)+import Data.Binary (put, get, Put, Get) import Data.Text.Binary ()-import System.Console.CmdArgs+-- import System.Console.CmdArgs import qualified Data.Set as S import qualified Data.Map as M-import qualified Data.Vector as V-import qualified Data.List as List+-- import qualified Data.Vector as V+-- import qualified Data.List as List  import qualified Data.DAG as DAG import           Data.DAG (DAG)
src/NLP/Concraft/DAG/DisambSeg.hs view
@@ -39,18 +39,18 @@  import Prelude hiding (words) import Control.Applicative ((<$>), (<*>), pure)-import Data.Binary (Binary, put, get, Put, Get)+import Data.Binary (put, get, Put, Get) import Data.Text.Binary ()-import System.Console.CmdArgs+-- import System.Console.CmdArgs import qualified Data.Set as S import qualified Data.Map as M-import qualified Data.Vector as V-import qualified Data.List as List+-- import qualified Data.Vector as V+-- import qualified Data.List as List  import qualified Data.DAG as DAG import           Data.DAG (DAG) -import qualified Control.Monad.Ox as Ox+-- import qualified Control.Monad.Ox as Ox import qualified Numeric.SGD.Momentum as SGD import qualified Data.CRF.Chain2.Tiers.DAG as CRF import qualified Data.Tagset.Positional as T@@ -240,11 +240,11 @@   -> (Tag -> [a])   -> [X.Sent w t]   -> [CRF.SentL Ob a]-schemed simpl schema split =+schemed simpl schema splitIt =     map onSent   where     onSent sent =-        let xs = fmap (X.mapSeg split) (X.mapSent simpl sent)+        let xs = fmap (X.mapSeg splitIt) (X.mapSent simpl sent)             mkProb = CRF.mkProb . M.toList . X.unWMap . X.tags         -- in  fmap (uncurry CRF.mkWordL) $         in  DAG.zipE (schematize schema xs) (fmap mkProb xs)
src/NLP/Concraft/DAG/Guess.hs view
@@ -131,17 +131,27 @@   -- | Determine the marginal probabilities of the individual labels in the sentence.-marginals :: (X.Word w, Ord t, Ord s) => Guesser t s -> X.Sent w t -> DAG () (X.WMap t)-marginals gsr = fmap X.tags . marginalsSent gsr+marginals+  :: (X.Word w, Ord t, Ord s)+  => CRF.Config s+  -> Guesser t s+  -> X.Sent w t+  -> DAG () (X.WMap t)+marginals cfg gsr = fmap X.tags . marginalsSent cfg gsr   -- | Replace the probabilities of the sentence labels with the marginal probabilities -- stemming from the model.-marginalsSent :: (X.Word w, Ord t, Ord s) => Guesser t s -> X.Sent w t -> X.Sent w t-marginalsSent gsr sent+marginalsSent+  :: (X.Word w, Ord t, Ord s)+  => CRF.Config s+  -> Guesser t s+  -> X.Sent w t+  -> X.Sent w t+marginalsSent cfg gsr sent   = (\new -> inject gsr new sent)   . fmap tags-  . marginalsCRF gsr+  . marginalsCRF cfg gsr   $ sent   where     tags = X.mkWMap . M.toList . considerZero . choice@@ -157,11 +167,16 @@   -- | Ascertain the marginal probabilities of to individual labels in the sentence.-marginalsCRF :: (X.Word w, Ord t, Ord s) => Guesser t s -> X.Sent w t -> CRF.SentL Ob s-marginalsCRF gsr dag0 =+marginalsCRF+  :: (X.Word w, Ord t, Ord s)+  => CRF.Config s+  -> Guesser t s+  -> X.Sent w t+  -> CRF.SentL Ob s+marginalsCRF cfg gsr dag0 =   let schema = fromConf (schemaConf gsr)       dag = X.mapSent (simplify gsr) dag0-  in  CRF.marginals (crf gsr) (schematize schema dag)+  in  CRF.marginals cfg (crf gsr) (schematize schema dag)   -- -- | Replace the probabilities of the sentence labels with the new probabilities
src/NLP/Concraft/DAG/Morphosyntax.hs view
@@ -31,15 +31,15 @@  import           Prelude hiding (Word) import           Control.Applicative ((<$>), (<*>))-import           Control.Arrow (first)+-- import           Control.Arrow (first) import           Data.Aeson-import           Data.Binary (Binary)+-- import           Data.Binary (Binary) import qualified Data.Set as S import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Lazy as L -import qualified Data.DAG as DAG+-- import qualified Data.DAG as DAG import           Data.DAG (DAG) -- import qualified Data.CRF.Chain1.Constrained.DAG.Dataset.Internal as DAG -- import           Data.CRF.Chain1.Constrained.DAG.Dataset.Internal (DAG)
src/NLP/Concraft/DAG/Schema.hs view
@@ -356,14 +356,14 @@ onEdgeWith dag f k = f <$> DAG.maybeEdgeLabel k dag  --- | Value of the given function with respect to the given sentence and its--- edge. Return `[]` if the edge is out of bounds.-onEdgeWith' :: DAG x a -> (a -> [b]) -> EdgeID -> [b]-onEdgeWith' dag f k =-  g $ f <$> DAG.maybeEdgeLabel k dag-  where-    g Nothing = []-    g (Just xs) = xs+-- -- | Value of the given function with respect to the given sentence and its+-- -- edge. Return `[]` if the edge is out of bounds.+-- onEdgeWith' :: DAG x a -> (a -> [b]) -> EdgeID -> [b]+-- onEdgeWith' dag f k =+--   g $ f <$> DAG.maybeEdgeLabel k dag+--   where+--     g Nothing = []+--     g (Just xs) = xs   -- | Move the specified number of edges forward or backward. This implementation@@ -388,6 +388,6 @@       shift (k + 1) j dag   | otherwise = return i   where-    mayHead (x:xs) = Just x+    mayHead (x:_) = Just x     mayHead [] = Nothing     mayTail = mayHead . reverse
src/NLP/Concraft/DAG/Segmentation.hs view
@@ -321,7 +321,7 @@   $ DAG.zipE dag ambiDag   where     ambiDag = Ambi.identifyAmbiguousSegments dag-    gather edgeID (seg, isAmbi)+    gather _edgeID (seg, isAmbi)       | isAmbi && prob >= eps =           AmbiStats {ambi = 1, total = 1}       | prob >= eps =@@ -329,6 +329,6 @@       | otherwise =           AmbiStats {ambi = 0, total = 0}       where-        isChosen = (prob >= eps) || (not onlyChosen)+        -- isChosen = (prob >= eps) || (not onlyChosen)         prob = sum . M.elems . X.unWMap $ X.tags seg         eps = 0.5
− src/NLP/Concraft/DAG2.hs
@@ -1,369 +0,0 @@-{-# LANGUAGE RecordWildCards #-}----- | Top-level module adated to DAGs, guessing and disambiguation.---module NLP.Concraft.DAG2-(--- * Model-  Concraft (..)-, saveModel-, loadModel----- * Annotation-, Anno-, replace---- * Best paths-, findOptimalPaths-, disambPath---- * Marginals--- , D.ProbType (..)-, guessMarginals-, disambMarginals-, disambProbs---- * Tagging-, guess-, guessSent-, tag--- , tag'---- * Training-, train---- * Pruning-, prune-) where---import           System.IO (hClose)-import           Control.Applicative ((<$>), (<*>)) -- , (<|>))-import           Control.Arrow (first)-import           Control.Monad (when, guard)--- import           Data.Maybe (listToMaybe)-import qualified Data.Foldable as F-import qualified Data.Set as S-import qualified Data.Map.Strict as M-import           Data.Binary (Binary, put, get, Put, Get)-import qualified Data.Binary as Binary-import           Data.Binary.Put (runPut)-import           Data.Binary.Get (runGet)-import           Data.Aeson-import qualified System.IO.Temp as Temp-import qualified Data.ByteString.Lazy as BL-import qualified Codec.Compression.GZip as GZip--import           Data.DAG (DAG, EdgeID)-import qualified Data.DAG as DAG--import qualified Data.Tagset.Positional as P---- import           NLP.Concraft.Analysis-import           NLP.Concraft.Format.Temp-import qualified NLP.Concraft.DAG.Morphosyntax as X-import           NLP.Concraft.DAG.Morphosyntax (Sent, WMap)-import qualified NLP.Concraft.DAG.Guess as G-import qualified NLP.Concraft.DAG.Disamb as D--------------------------- Model-------------------------modelVersion :: String-modelVersion = "dag2:0.11"----- | Concraft data.-data Concraft t = Concraft-  { tagset        :: P.Tagset-  , guessNum      :: Int-  , guesser       :: G.Guesser t P.Tag-  , disamb        :: D.Disamb t }----- instance (Ord t, Binary t) => Binary (Concraft t) where---     put Concraft{..} = do---         put modelVersion---         put tagset---         put guessNum---         put guesser---         put disamb---     get = do---         comp <- get---         when (comp /= modelVersion) $ error $---             "Incompatible model version: " ++ comp ++---             ", expected: " ++ modelVersion---         Concraft <$> get <*> get <*> get  <*> get---putModel :: (Ord t, Binary t) => Concraft t -> Put-putModel Concraft{..} = do-  put modelVersion-  put tagset-  put guessNum-  G.putGuesser guesser-  D.putDisamb disamb----- | Get the model, given the tag simplification function for the disambigutation model.-getModel-  :: (Ord t, Binary t)-  => (P.Tagset -> t -> P.Tag)-     -- ^ Simplification function-  -> Get (Concraft t)-getModel smp = do-  comp <- get-  when (comp /= modelVersion) $ error $-    "Incompatible model version: " ++ comp ++-    ", expected: " ++ modelVersion-  tagset <- get-  Concraft tagset <$> get <*> G.getGuesser (smp tagset) <*> D.getDisamb (smp tagset)----- | Save model in a file.  Data is compressed using the gzip format.-saveModel :: (Ord t, Binary t) => FilePath -> Concraft t -> IO ()--- saveModel path = BL.writeFile path . GZip.compress . Binary.encode-saveModel path = BL.writeFile path . GZip.compress . runPut . putModel----- | Load model from a file.-loadModel :: (Ord t, Binary t) => (P.Tagset -> t -> P.Tag) -> FilePath -> IO (Concraft t)-loadModel smp path = do-    -- x <- Binary.decode . GZip.decompress <$> BL.readFile path-    x <- runGet (getModel smp) . GZip.decompress <$> BL.readFile path-    x `seq` return x---------------------------- Annotation---------------------------- | DAG annotation, assignes @b@ values to @a@ labels for each edge in the--- graph.-type Anno a b = DAG () (M.Map a b)----- | Replace sentence probability values with the given annotation.-replace :: (Ord t) => Anno t Double -> Sent w t -> Sent w t-replace anno sent =-  fmap join $ DAG.zipE anno sent-  where-    join (m, seg) = seg {X.tags = X.fromMap m}---     apply f---       = X.fromMap---       . M.mapWithKey (\key _val -> f M.! key)---       . X.unWMap----- | Extract marginal annotations from the given sentence.-extract :: Sent w t -> Anno t Double-extract = fmap $ X.unWMap . X.tags---------------------------- Best path---------------------------- | 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----- | 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)---------------------------- Marginals and Probs---------------------------- | Determine marginal probabilities corresponding to individual--- tags w.r.t. the guessing model.-guessMarginals :: (X.Word w, Ord t) => G.Guesser t P.Tag -> Sent w t -> Anno t Double-guessMarginals gsr = fmap X.unWMap . G.marginals gsr----- | Determine marginal probabilities corresponding to individual--- tags w.r.t. the guessing 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.-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------------------------------------------------------- Trimming------------------------------------------------------- | Trim down the set of potential labels to `k` most probable ones--- for each OOV word in the sentence.-trimOOV :: (X.Word w, Ord t) => Int -> Sent w t -> Sent w t-trimOOV k =-  fmap trim-  where-    trim edge = if X.oov edge-      then trimEdge edge-      else edge-    trimEdge edge = edge {X.tags = X.trim k (X.tags edge)}--------------------------- Tagging--------------------------- | Determine marginal probabilities corresponding to individual tags w.r.t.--- the guessing model and, afterwards, trim the sentence to keep only the `k`--- most probably labels for each OOV edge. Note that, for OOV words, the entire--- set of default tags is considered.-guessSent :: (X.Word w, Ord t) => Int -> G.Guesser t P.Tag -> Sent w t -> Sent w t-guessSent k gsr sent = trimOOV k $ replace (guessMarginals gsr sent) sent----- | Perform guessing, trimming, and finally determine marginal probabilities--- corresponding to individual tags w.r.t. the guessing model.-guess :: (X.Word w, Ord t) => Int -> G.Guesser t P.Tag -> Sent w t -> Anno t Double-guess k gsr = extract . guessSent k gsr----- | Perform guessing, trimming, and finally determine marginal probabilities--- corresponding to individual tags w.r.t. the disambiguation model.-tag :: (X.Word w, Ord t) => Int -> Concraft t -> Sent w t -> Anno t Double-tag k crf = disambMarginals (disamb crf) . guessSent k (guesser crf)----- -- | Perform guessing, trimming, and finally determine probabilities--- -- corresponding to individual tags w.r.t. the disambiguation model.--- tag' :: X.Word w => Int -> D.ProbType -> Concraft -> Sent w P.Tag -> Anno P.Tag Double--- tag' k typ Concraft{..} = disambProbs typ disamb . guessSent k guesser--------------------------- Training--------------------------- | Train the `Concraft` model.--- No reanalysis of the input data will be performed.------ The `FromJSON` and `ToJSON` instances are used to store processed--- input data in temporary files on a disk.-train-    :: (X.Word w, Ord t)-    => P.Tagset             -- ^ A morphosyntactic tagset to which `P.Tag`s-                            --   of the training and evaluation input data-                            --   must correspond.-    -> Int                  -- ^ How many tags is the guessing model supposed-                            --   to produce for a given OOV word?  It will be-                            --   used (see `G.guessSent`) on both training and-                            --   evaluation input data prior to the training-                            --   of the disambiguation model.-    -> G.TrainConf t P.Tag  -- ^ Training configuration for the guessing model.-    -> D.TrainConf t        -- ^ Training configuration for the-                            --   disambiguation model.-    -> IO [Sent w t]    -- ^ Training dataset.  This IO action will be-                            --   executed a couple of times, so consider using-                            --   lazy IO if your dataset is big.-    -> IO [Sent w t]    -- ^ Evaluation dataset IO action.  Consider using-                            --   lazy IO if your dataset is big.-    -> IO (Concraft t)-train tagset guessNum guessConf disambConf trainR'IO evalR'IO = do-  Temp.withTempDirectory "." ".guessed" $ \tmpDir -> do-  let temp = withTemp tagset tmpDir--  putStrLn "\n===== Train guessing model ====="-  guesser <- G.train guessConf trainR'IO evalR'IO-  let guess = guessSent guessNum guesser-  trainG  <- map guess <$> trainR'IO-  evalG   <- map guess <$> evalR'IO--  temp "train" trainG $ \trainG'IO -> do-  temp "eval"  evalG  $ \evalG'IO  -> do--  putStrLn "\n===== Train disambiguation model ====="-  disamb <- D.train disambConf trainG'IO evalG'IO-  return $ Concraft tagset guessNum guesser disamb--------------------------- Temporary storage--------------------------- | Store dataset on a disk and run a handler on a list which is read--- lazily from the disk.  A temporary file will be automatically--- deleted after the handler is done.------ NOTE: (11/11/2017): it's just a dummy function right now, which does--- not use disk storage at all.----withTemp-  -- :: (FromJSON w, ToJSON w)-  :: P.Tagset-  -> FilePath                     -- ^ Directory to create the file in-  -> String                       -- ^ Template for `Temp.withTempFile`-  -> [Sent w t]                   -- ^ Input dataset-  -> (IO [Sent w t] -> IO a)      -- ^ Handler-  -> IO a-withTemp _      _   _    [] handler = handler (return [])-withTemp tagset dir tmpl xs handler =-  Temp.withTempFile dir tmpl $ \tmpPath tmpHandle -> do-    hClose tmpHandle-    let txtSent = X.mapSent $ P.showTag tagset-        tagSent = X.mapSent $ P.parseTag tagset-    handler (return xs)--------------------------- Pruning--------------------------- | Prune disambiguation model: discard model features with--- absolute values (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' }
src/NLP/Concraft/DAGSeg.hs view
@@ -40,20 +40,20 @@   -- import           Prelude hiding (Word)-import           System.IO (hClose)+-- import           System.IO (hClose) import           Control.Applicative ((<$>), (<*>)) -- , (<|>))-import           Control.Arrow (first, second)+import           Control.Arrow (second) import           Control.Monad (when, guard) -- import           Data.Maybe (listToMaybe)-import qualified Data.Foldable as F+-- import qualified Data.Foldable as F import qualified Data.Set as S import qualified Data.Map.Strict as M import           Data.Binary (Binary, put, get, Put, Get)-import qualified Data.Binary as Binary+-- import qualified Data.Binary as Binary import           Data.Binary.Put (runPut) import           Data.Binary.Get (runGet)-import           Data.Aeson-import qualified System.IO.Temp as Temp+-- import           Data.Aeson+-- import qualified System.IO.Temp as Temp import qualified Data.ByteString.Lazy as BL import qualified Codec.Compression.GZip as GZip import           Data.Ord (comparing)@@ -64,10 +64,12 @@  import qualified Data.Tagset.Positional as P +import qualified Data.CRF.Chain1.Constrained.DAG as CRF+ -- import           NLP.Concraft.Analysis-import           NLP.Concraft.Format.Temp+-- import           NLP.Concraft.Format.Temp import qualified NLP.Concraft.DAG.Morphosyntax as X-import           NLP.Concraft.DAG.Morphosyntax (Sent, WMap)+import           NLP.Concraft.DAG.Morphosyntax (Sent) import qualified NLP.Concraft.DAG.Guess as G import qualified NLP.Concraft.DAG.DisambSeg as D @@ -223,8 +225,8 @@     doit i = inside i ++ final i     inside i = do       let tags =-            [ tag-            | (tag, weight) <- M.toList (DAG.edgeLabel i dag)+            [ tak+            | (tak, weight) <- M.toList (DAG.edgeLabel i dag)             , weight >= 1.0 - eps ]       guard . not $ null tags       j <- DAG.nextEdges i dag@@ -233,8 +235,8 @@     final i = do       guard $ DAG.isFinalEdge i dag       let tags =-            [ tag-            | (tag, weight) <- M.toList (DAG.edgeLabel i dag)+            [ tak+            | (tak, weight) <- M.toList (DAG.edgeLabel i dag)             , weight >= 1.0 - eps ]       guard . not $ null tags       return [(i, S.fromList tags)]@@ -274,8 +276,13 @@  -- | Determine marginal probabilities corresponding to individual -- tags w.r.t. the guessing model.-guessMarginals :: (X.Word w, Ord t) => G.Guesser t P.Tag -> Sent w t -> Anno t Double-guessMarginals gsr = fmap X.unWMap . G.marginals gsr+guessMarginals+  :: (X.Word w, Ord t)+  => CRF.Config P.Tag+  -> G.Guesser t P.Tag+  -> Sent w t+  -> Anno t Double+guessMarginals cfg gsr = fmap X.unWMap . G.marginals cfg gsr   -- | Determine marginal probabilities corresponding to individual@@ -330,21 +337,40 @@ -- most probably labels for each OOV edge. Note that, for OOV words, the entire -- set of default tags is considered. ---guessSent :: (X.Word w, Ord t) => Int -> G.Guesser t P.Tag -> Sent w t -> Sent w t-guessSent k gsr sent = insertGuessed (fmap (trimMap k) (guessMarginals gsr sent)) sent--- guessSent k gsr sent = trimOOV k $ replace (guessMarginals gsr sent) sent+guessSent ::+     (X.Word w, Ord t)+  => Int+  -> CRF.Config P.Tag+  -> G.Guesser t P.Tag+  -> Sent w t+  -> Sent w t+guessSent k cfg gsr sent =+  insertGuessed (fmap (trimMap k) (guessMarginals cfg gsr sent)) sent   -- | Perform guessing, trimming, and finally determine marginal probabilities -- corresponding to individual tags w.r.t. the guessing model.-guess :: (X.Word w, Ord t) => Int -> G.Guesser t P.Tag -> Sent w t -> Anno t Double-guess k gsr sent = extract . trimOOV k $ replace (guessMarginals gsr sent) sent+guess ::+     (X.Word w, Ord t)+  => Int+  -> CRF.Config P.Tag+  -> G.Guesser t P.Tag+  -> Sent w t+  -> Anno t Double+guess k cfg gsr sent =+  extract . trimOOV k $ replace (guessMarginals cfg gsr sent) sent   -- | Perform guessing, trimming, and finally determine marginal probabilities -- corresponding to individual tags w.r.t. the disambiguation model.-tag :: (X.Word w, Ord t) => Int -> Concraft t -> Sent w t -> Anno t Double-tag k crf = disambMarginals (disamb crf) . guessSent k (guesser crf)+tag ::+     (X.Word w, Ord t)+  => Int+  -> CRF.Config P.Tag+  -> Concraft t+  -> Sent w t+  -> Anno t Double+tag k cfg crf = disambMarginals (disamb crf) . guessSent k cfg (guesser crf)   ---------------------
src/NLP/Concraft/Morphosyntax.hs view
@@ -31,9 +31,9 @@  import           Prelude hiding (Word) import           Control.Applicative ((<$>), (<*>))-import           Control.Arrow (first)+-- import           Control.Arrow (first) import           Data.Aeson-import           Data.Binary (Binary)+-- import           Data.Binary (Binary) import qualified Data.Set as S import qualified Data.Map as M import qualified Data.Text as T