concraft-pl 2.0.2 → 2.1.0
raw patch · 8 files changed
+85/−54 lines, 8 filesdep ~concraftdep ~crf-chain1-constrained
Dependency ranges changed: concraft, crf-chain1-constrained
Files
- changelog +3/−0
- concraft-pl.cabal +3/−3
- src/NLP/Concraft/Polish/DAG/Format/Base.hs +5/−5
- src/NLP/Concraft/Polish/DAG/Morphosyntax.hs +6/−6
- src/NLP/Concraft/Polish/DAG/Server.hs +1/−1
- src/NLP/Concraft/Polish/DAGSeg.hs +40/−36
- src/NLP/Concraft/Polish/Format/Plain.hs +1/−1
- tools/concraft-pl.hs +26/−2
changelog view
@@ -1,5 +1,8 @@ -*-change-log-*- +2.1.0 Sep 2018+ * External configuration of blacklisted tags+ 2.0.1 Jul 2018 * External configuration of disambiguation tiers
concraft-pl.cabal view
@@ -1,5 +1,5 @@ name: concraft-pl-version: 2.0.2+version: 2.1.0 synopsis: Morphological tagger for Polish description: A morphological tagger for Polish based on the concraft library.@@ -24,9 +24,9 @@ hs-source-dirs: src build-depends: base >= 4 && < 5- , concraft >= 0.11 && < 0.12+ , concraft >= 0.12 && < 0.13 , pedestrian-dag >= 0.2 && < 0.3- , crf-chain1-constrained >= 0.4 && < 0.5+ , crf-chain1-constrained >= 0.5 && < 0.6 , crf-chain2-tiers >= 0.3 && < 0.4 , tagset-positional >= 0.3 && < 0.4 , sgd >= 0.4 && < 0.5
src/NLP/Concraft/Polish/DAG/Format/Base.hs view
@@ -21,7 +21,7 @@ import Data.Monoid (mconcat, mappend) import qualified Data.Map as M import Data.List (intersperse, groupBy)-import Data.Maybe (listToMaybe)+-- import Data.Maybe (listToMaybe) import Data.String (IsString) import Data.Data (Data) import Data.Typeable (Typeable)@@ -37,7 +37,7 @@ import qualified NLP.Concraft.DAG.Morphosyntax as X -- import qualified NLP.Concraft.Polish.DAG2 as C -- import NLP.Concraft.Polish.DAG2 (AnnoSent(..))-import qualified NLP.Concraft.Polish.DAGSeg as C+-- import qualified NLP.Concraft.Polish.DAGSeg as C import NLP.Concraft.Polish.DAGSeg (AnnoSent(..)) import qualified NLP.Concraft.Polish.Morphosyntax as I @@ -114,9 +114,9 @@ let tailNode = DAG.begsWith edgeID dag headNode = DAG.endsWith edgeID dag X.Seg{..} = DAG.edgeLabel edgeID dag- interp <- map Just (M.toList (X.unWMap tags)) +++ interpWeight <- map Just (M.toList (X.unWMap tags)) ++ if known word then [] else [Nothing]- return $ case interp of+ return $ case interpWeight of Just (interp@Interp{..}, weight) -> buildInterp showCfg tailNode headNode word interp (case probType showCfg of@@ -291,7 +291,7 @@ readTyp :: (Read a) => String -> String -> a readTyp typ x = case readMaybe x of- Just x -> x+ Just y -> y Nothing -> error $ "unable to parse \"" ++ x ++ "\" to a " ++ typ -- "Unable to parse <" ++ typ ++ ">" ++
src/NLP/Concraft/Polish/DAG/Morphosyntax.hs view
@@ -43,16 +43,16 @@ import Prelude hiding (Word) import Control.Applicative ((<$>), (<*>)) -- import Control.Arrow (first)-import Control.Monad (guard)-import Data.Binary (Binary, put, get, putWord8, getWord8)+-- import Control.Monad (guard)+import Data.Binary (Binary, put, get) import Data.Aeson-import qualified Data.Aeson as Aeson+-- import qualified Data.Aeson as Aeson import qualified Data.Set as S import qualified Data.Map.Strict as M-import Data.Maybe (catMaybes)+-- import Data.Maybe (catMaybes) import qualified Data.Text as T import qualified Data.Text.Lazy as L-import qualified Data.Tagset.Positional as P+-- import qualified Data.Tagset.Positional as P import Data.DAG (DAG) import qualified Data.DAG as DAG@@ -62,7 +62,7 @@ -- import qualified NLP.Concraft.DAG2 as C import qualified NLP.Concraft.DAG.Morphosyntax as X import qualified NLP.Concraft.DAG.Segmentation as Seg-import qualified NLP.Concraft.Polish.Morphosyntax as R+-- import qualified NLP.Concraft.Polish.Morphosyntax as R import NLP.Concraft.Polish.Morphosyntax (Space(..))
src/NLP/Concraft/Polish/DAG/Server.hs view
@@ -23,7 +23,7 @@ ) where -import Control.Monad.IO.Class (liftIO)+-- import Control.Monad.IO.Class (liftIO) import GHC.Generics
src/NLP/Concraft/Polish/DAGSeg.hs view
@@ -10,7 +10,7 @@ ( -- * Types- Tag (..)+ Tag -- ** Simplification , simplify4gsr , simplify4dmb@@ -41,22 +41,25 @@ ) where -import Prelude hiding (Word)+import Prelude hiding (Word, pred) import Control.Applicative ((<$>))-import Control.Arrow (first)+-- import Control.Arrow (first) import Control.Monad (guard) import Data.Maybe (listToMaybe)-import qualified Data.Text.Lazy as L+import qualified Data.Text as T+-- import qualified Data.Text.Lazy as L import qualified Data.Set as S import qualified Data.Map.Strict as M-import Data.Data (Data)-import Data.Typeable (Typeable)+-- import Data.Data (Data)+-- import Data.Typeable (Typeable) import qualified Data.Tagset.Positional as P import qualified Numeric.SGD.Momentum as SGD import qualified Data.DAG as DAG +import qualified Data.CRF.Chain1.Constrained.DAG as CRF+ import qualified NLP.Concraft.DAG.Morphosyntax as X import qualified NLP.Concraft.DAG.Morphosyntax.Ambiguous as XA import qualified NLP.Concraft.DAG.Schema as S@@ -209,39 +212,30 @@ -- | Tag the sentence with guessing marginal probabilities.-guess :: C.Concraft Tag -> Sent Tag -> Sent Tag-guess = tagWith (C.guessMarginals . C.guesser)----- | Tag the sentence with disambiguation marginal probabilities.-disamb :: C.Concraft Tag -> Sent Tag -> Sent Tag-disamb = tagWith (C.disambMarginals . C.disamb)+guess :: CRF.Config P.Tag -> C.Concraft Tag -> Sent Tag -> Sent Tag+guess cfg = tagWith (C.guessMarginals cfg . C.guesser) --- | Tag the sentence with disambiguation probabilities.-disamb' :: C.Concraft Tag -> D.ProbType -> Sent Tag -> Sent Tag-disamb' crf typ = tagWith (C.disambProbs typ . C.disamb) crf+-- -- | Tag the sentence with disambiguation marginal probabilities.+-- disamb :: C.Concraft Tag -> Sent Tag -> Sent Tag+-- disamb = tagWith (C.disambMarginals . C.disamb) --- | Perform guessing -> trimming -> disambiguation.-tag- :: Int- -- ^ Trimming parameter- -> C.Concraft Tag- -> Sent Tag- -> Sent Tag-tag = tagWith . C.tag+-- -- | Tag the sentence with disambiguation probabilities.+-- disamb' :: C.Concraft Tag -> D.ProbType -> Sent Tag -> Sent Tag+-- disamb' crf typ = tagWith (C.disambProbs typ . C.disamb) crf -- -- | Perform guessing -> trimming -> disambiguation.--- tag'--- :: Int--- -- ^ Trimming parameter--- -> D.ProbType--- -> C.Concraft+-- tag ::+-- Int +-- -- ^ Trimming parameter+-- -> CRF.Config P.Tag+-- -- ^ Blacklist+-- -> C.Concraft Tag -- -> Sent Tag -- -> Sent Tag--- tag' k probTyp = tagWith (C.tag' k probTyp)+-- tag k cfg = tagWith $ C.tag k cfg -- | Tag with the help of a lower-level annotation function.@@ -393,6 +387,8 @@ -- ^ How many morphosyntactic tags should be kept for OOV words , pickPath :: Maybe Seg.PathTyp -- ^ Which path picking method should be used. The function takes the+ , blackSet :: S.Set T.Text+ -- ^ The set of blacklisted tags } @@ -430,12 +426,19 @@ case pickPath of Just typ -> Seg.pickPath typ sent00 Nothing -> sent00+ + -- Parsed blacklisted tags and CRF config+ blackSet' =+ S.fromList . map (P.parseTag (C.tagset concraft)) . S.toList $ blackSet+ -- Make sure that the blackset is evaluated (otherwise, some malfored+ -- tags may be silentely ignored by the tool)+ crfCfg = length (show blackSet') `seq` CRF.Config {blackSet = blackSet'} -- We add EOS markers only after guessing, because the possible tags are not -- yet determined for the OOV words. ambiDag = XA.identifyAmbiguousSegments sent0 _guessSent0 = DAG.mapE (addEosMarkers ambiDag) $- tagWith (C.guess trimParam . C.guesser) concraft sent0+ tagWith (C.guess trimParam crfCfg . C.guesser) concraft sent0 -- Resolve EOS tags based on the segmentation model _guessSent1 = segment . fmap (resolveEOS 0.5) $ tagWith (C.disambProbs D.MaxProbs . C.segmenter) concraft _guessSent0@@ -507,18 +510,19 @@ putStrLn "\n===== Train guessing model =====" guesser <- G.train (guessConf parBatchSize) trainR'IO evalR'IO- let guess = C.guessSent guessNum guesser+ let crfCfg = CRF.Config {blackSet = S.empty}+ doGuess = C.guessSent guessNum crfCfg guesser prepSent dag = let ambiDag = XA.identifyAmbiguousSegments dag- in DAG.mapE (addEosMarkers ambiDag) (guess dag)+ in DAG.mapE (addEosMarkers ambiDag) (doGuess dag) trainG'IO = map prepSent <$> trainR'IO evalG'IO = map prepSent <$> evalR'IO putStrLn "\n===== Train sentence segmentation model =====" segmenter <- D.train (segmentConf parBatchSize) trainG'IO evalG'IO- let prepSent = segment . fmap (resolveEOS 0.5)- trainS'IO = concatMap prepSent <$> trainG'IO- evalS'IO = concatMap prepSent <$> evalG'IO+ let prepSent' = segment . fmap (resolveEOS 0.5)+ trainS'IO = concatMap prepSent' <$> trainG'IO+ evalS'IO = concatMap prepSent' <$> evalG'IO putStrLn "\n===== Train disambiguation model =====" disamb <- D.train disambConf trainS'IO evalS'IO
src/NLP/Concraft/Polish/Format/Plain.hs view
@@ -19,7 +19,7 @@ , showSent ) where -import Prelude hiding ((<>))+-- import Prelude hiding ((<>)) import Data.Monoid (Monoid, mappend, mconcat) import Data.Maybe (catMaybes) import Data.List (groupBy)
tools/concraft-pl.hs view
@@ -87,6 +87,7 @@ -- , marginals :: Bool , inFile :: Maybe FilePath , outFile :: Maybe FilePath+ , blackFile :: Maybe FilePath , probType :: DB.ProbType -- , suppressProbs :: Bool , mayGuessNum :: Maybe Int@@ -98,6 +99,7 @@ } | Server { inModel :: FilePath+ , blackFile :: Maybe FilePath , probType :: DB.ProbType , mayGuessNum :: Maybe Int , numericDisamb :: Bool@@ -173,6 +175,7 @@ -- , marginals = False &= help "Tag with marginal probabilities" } , inFile = def &= typFile &= help "Input file (stdin by default)" , outFile = def &= typFile &= help "Output file (stdout by default)"+ , blackFile = def &= typFile &= help "File with blacklisted tags, one per line" , probType = DB.Marginals &= help "Type of probabilities" -- , suppressProbs = False &= help "Do not show probabilities" , freqPath = def &= typFile &= help "File with chosen/not-chosen counts"@@ -191,6 +194,7 @@ serverMode :: Concraft serverMode = Server { inModel = def &= argPos 0 &= typ "MODEL-FILE"+ , blackFile = def &= typFile &= help "File with blacklisted tags, one per line" , probType = DB.Marginals &= help "Type of probabilities" , mayGuessNum = def &= help "Number of guessed tags for each unknown word" , numericDisamb = False &= help@@ -327,12 +331,16 @@ inp <- DB.parseData <$> case inFile of Nothing -> getContentsUtf8 Just path -> readFileUtf8 path+ blackSet <-+ case blackFile of+ Nothing -> pure S.empty+ Just path -> readBlackSet path pathSelection <- case (shortestPath, longestPath, freqPath) of (True, _, _) -> return $ Just Seg.Min (_, True, _) -> return $ Just Seg.Max- (_, _, Just freqPath) -> do- freqMap <- loadFreqMap freqPath+ (_, _, Just freqPath') -> do+ freqMap <- loadFreqMap freqPath' let conf = Seg.FreqConf { Seg.pickFreqMap = freqMap , Seg.smoothingParam = freqSmoothing@@ -345,6 +353,7 @@ cfg = Pol.AnnoConf { trimParam = guessNum , pickPath = pathSelection+ , blackSet = blackSet } out = Pol.annoAll cfg crf <$> inp showCfg = DB.ShowCfg@@ -358,12 +367,17 @@ exec Server{..} = do crf <- Pol.loadModel Pol.simplify4gsr Pol.simplify4dmb inModel+ blackSet <-+ case blackFile of+ Nothing -> pure S.empty+ Just path -> readBlackSet path let guessNum = case mayGuessNum of Nothing -> C.guessNum crf Just k -> k cfg = Pol.AnnoConf { trimParam = guessNum , pickPath = Nothing+ , blackSet = blackSet } showCfg = DB.ShowCfg { probType = probType@@ -524,6 +538,16 @@ (orth, (readInt chosen, readInt notChosen)) _ -> error $ "loadFreqMap: line incorrectly formatted: " ++ T.unpack line readInt = read . T.unpack+++---------------------------------------+-- Blacklist+---------------------------------------+++readBlackSet :: FilePath -> IO (S.Set T.Text)+readBlackSet path =+ S.fromList . map (L.toStrict . L.strip) . L.lines <$> readFileUtf8 path ---------------------------------------