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 +4/−0
- concraft.cabal +5/−3
- src/NLP/Concraft.hs +4/−4
- src/NLP/Concraft/DAG/Disamb.hs +4/−4
- src/NLP/Concraft/DAG/DisambSeg.hs +7/−7
- src/NLP/Concraft/DAG/Guess.hs +23/−8
- src/NLP/Concraft/DAG/Morphosyntax.hs +3/−3
- src/NLP/Concraft/DAG/Schema.hs +9/−9
- src/NLP/Concraft/DAG/Segmentation.hs +2/−2
- src/NLP/Concraft/DAG2.hs +0/−369
- src/NLP/Concraft/DAGSeg.hs +47/−21
- src/NLP/Concraft/Morphosyntax.hs +2/−2
+ 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