concraft-pl 2.1.1 → 2.4.0
raw patch · 5 files changed
+123/−61 lines, 5 filesdep ~concraftdep ~crf-chain1-constraineddep ~crf-chain2-tiers
Dependency ranges changed: concraft, crf-chain1-constrained, crf-chain2-tiers
Files
- changelog +9/−0
- concraft-pl.cabal +4/−4
- src/NLP/Concraft/Polish/DAG/Server.hs +4/−1
- src/NLP/Concraft/Polish/DAGSeg.hs +57/−32
- tools/concraft-pl.hs +49/−24
changelog view
@@ -1,5 +1,14 @@ -*-change-log-*- +2.4.0 Oct 2018+ * DAG verification improved++2.3.0 Oct 2018+ * Faster disambiguation (using "fastTag" from the 2-order CRF library)++2.2.0 Sep 2018+ * Make '/parse' in the server address implicit+ 2.1.0 Sep 2018 * External configuration of blacklisted tags
concraft-pl.cabal view
@@ -1,5 +1,5 @@ name: concraft-pl-version: 2.1.1+version: 2.4.0 synopsis: Morphological tagger for Polish description: A morphological tagger for Polish based on the concraft library.@@ -24,10 +24,10 @@ hs-source-dirs: src build-depends: base >= 4 && < 5- , concraft >= 0.12 && < 0.13+ , concraft >= 0.14 && < 0.15 , pedestrian-dag >= 0.2 && < 0.3- , crf-chain1-constrained >= 0.5 && < 0.6- , crf-chain2-tiers >= 0.3 && < 0.4+ , crf-chain1-constrained >= 0.6 && < 0.7+ , crf-chain2-tiers >= 0.6 && < 0.7 , tagset-positional >= 0.3 && < 0.4 , sgd >= 0.4 && < 0.5 , containers >= 0.4 && < 0.6
src/NLP/Concraft/Polish/DAG/Server.hs view
@@ -114,6 +114,7 @@ data ClientCfg = ClientCfg { serverAddr :: String+ , portNumber :: Int } @@ -123,6 +124,8 @@ -> IO (Maybe Answer) sendRequest ClientCfg{..} req = do let json = A.toJSON req- r <- Wreq.post serverAddr json+ trimAddr = reverse . dropWhile (=='/') . reverse+ server = trimAddr serverAddr ++ ":" ++ show portNumber ++ "/parse"+ r <- Wreq.post server json let result = A.decode =<< r ^? Wreq.responseBody return result
src/NLP/Concraft/Polish/DAGSeg.hs view
@@ -13,6 +13,7 @@ Tag -- ** Simplification , simplify4gsr+, complexify4gsr , simplify4dmb -- ** Model@@ -216,28 +217,6 @@ guess cfg = tagWith (C.guessMarginals cfg . C.guesser) --- -- | Tag the sentence with disambiguation marginal probabilities.--- disamb :: C.Concraft Tag -> Sent Tag -> Sent Tag--- disamb = tagWith (C.disambMarginals . C.disamb)----- -- | 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--- -> CRF.Config P.Tag--- -- ^ Blacklist--- -> C.Concraft Tag--- -> Sent Tag--- -> Sent Tag--- tag k cfg = tagWith $ C.tag k cfg-- -- | Tag with the help of a lower-level annotation function. tagWith -- :: (C.Concraft Tag -> X.Sent Word P.Tag -> C.Anno P.Tag Double)@@ -291,15 +270,41 @@ , (interp {eos=False}, p) ] --- | Decide if the word should be marked as eos or not.+-- | Mark the word as EOS or not. resolveEOS+ :: X.Seg Word Tag+ -> M.Map Tag Bool+ -> X.Seg Word Tag+resolveEOS seg selMap+ | isEos = seg {X.tags = markEos}+ | otherwise = seg {X.tags = markNoEos}+ where+ isEos = not (null chosen) && all PolX.eos chosen+ chosen = [interp | (interp, True) <- M.toList selMap]+ -- Mark the segment as EOS or not+ markEos = X.mkWMap+ [ (interp {PolX.eos=True}, p)+ | (interp, p) <- M.toList (X.unWMap tagMap) ]+ markNoEos = X.mkWMap+ [ (interp {PolX.eos=False}, p)+ | (interp, p) <- M.toList (X.unWMap tagMap) ]+ tagMap = X.tags seg+++-- | Decide if the word should be marked as eos or not, based on marginal+-- probabilities.+--+-- TODO: we don't need this heavy machinery any more. This function is now+-- only used for training data preparation.+--+resolveEOS' :: Double -- ^ 0.5 means that the probability of the tag being EOS is twice as high -- as that of not being EOS. 1.0 means that EOS will be marked only if its -- 100% probable. -> X.Seg Word Tag -> X.Seg Word Tag-resolveEOS minProp seg+resolveEOS' minProp seg | isEos = seg {X.tags = markEos} | otherwise = seg {X.tags = markNoEos} where@@ -440,23 +445,37 @@ _guessSent0 = DAG.mapE (addEosMarkers ambiDag) $ 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+-- _guessSent1 = segment . fmap (resolveEOS' 0.5) $+-- tagWith (C.disambProbs D.MaxProbs . C.segmenter) concraft _guessSent0+ _guessSent1 = segment . fmap (uncurry resolveEOS) . DAG.zipE _guessSent0 $+ annoWith (C.disamb . C.segmenter) concraft _guessSent0 +-- -- TEMP+-- _guessSent1 = (:[]) $+-- tagWith (C.guess trimParam crfCfg . C.guesser) concraft sent0+-- -- tagWith (const clearIt) concraft sent0+-- -- clearIt = fmap (fmap (const 0.0) . X.unWMap . X.tags) . DAG.mapN (const ())+ annoOne _guessSent = AnnoSent { guessSent = _guessSent , disambs = _disambs , marginals = _marginals , maxProbs = _maxProbs+-- , disambs = clearDAG _guessSent+-- , marginals = clearDAG _guessSent+-- , maxProbs = clearDAG _guessSent } where+-- clearDAG = fmap (const M.empty) . DAG.mapN (const ()) _marginals =- annoWith (C.disambProbs D.Marginals . C.disamb) concraft _guessSent+ annoWith (C.disambProbs D.Marginals . C.disamber) concraft _guessSent _maxProbs =- annoWith (C.disambProbs D.MaxProbs . C.disamb) concraft _guessSent+ annoWith (C.disambProbs D.MaxProbs . C.disamber) concraft _guessSent _disambs =- C.disambPath (optimal _maxProbs) _maxProbs- where optimal = maybe [] id . listToMaybe . C.findOptimalPaths+ annoWith (C.disamb . C.disamber) concraft _guessSent+-- _disambs =+-- C.disambPath (optimal _maxProbs) _maxProbs+-- where optimal = maybe [] id . listToMaybe . C.findOptimalPaths -------------------------------------------------@@ -520,7 +539,7 @@ putStrLn "\n===== Train sentence segmentation model =====" segmenter <- D.train (segmentConf parBatchSize) trainG'IO evalG'IO- let prepSent' = segment . fmap (resolveEOS 0.5)+ let prepSent' = segment . fmap (resolveEOS' 0.5) trainS'IO = concatMap prepSent' <$> trainG'IO evalS'IO = concatMap prepSent' <$> evalG'IO @@ -535,7 +554,9 @@ guessSchemaDefault (sgdArgs {SGD.batchSize = batchSize}) onDisk r0 zeroProbLabel- (simplify4gsr tagset) strip4gsr+ (simplify4gsr tagset)+ (complexify4gsr tagset)+ strip4gsr guessOnlyVisible strip4gsr interp = PolX.voidInterp (PolX.tag interp) @@ -567,6 +588,10 @@ -- things). simplify4gsr :: P.Tagset -> PolX.Interp PolX.Tag -> P.Tag simplify4gsr tagset PolX.Interp{..} = P.parseTag tagset tag+++complexify4gsr :: P.Tagset -> P.Tag -> PolX.Interp PolX.Tag+complexify4gsr tagset tag = PolX.voidInterp (P.showTag tagset tag) -- -- | Train the `Concraft` model.
tools/concraft-pl.hs view
@@ -30,6 +30,7 @@ import qualified Data.CRF.Chain1.Constrained.DAG.Dataset.Codec as CRF.Codec import qualified Data.CRF.Chain1.Constrained.DAG.Train as CRF.Train+import Data.CRF.Chain1.Constrained.DAG.Train (Error(..)) import qualified NLP.Concraft.DAG.Guess as Guess import qualified NLP.Concraft.DAG.Schema as Schema@@ -107,6 +108,7 @@ } | Client { serverAddr :: String+ , port :: Int , inFile :: Maybe FilePath , outFile :: Maybe FilePath , batchSize :: Int@@ -122,7 +124,7 @@ , ignoreTags :: Bool , heedEos :: Bool , weak :: Bool- , discardProb0 :: Bool+ -- , discardProb0 :: Bool , verbose :: Bool } | Check@@ -205,7 +207,8 @@ clientMode :: Concraft clientMode = Client- { serverAddr = "http://localhost:3000/parse" &= help "Server address"+ { serverAddr = "http://localhost" &= help "Server address"+ , port = 3000 &= help "Server port number" , inFile = def &= typFile &= help "Input file (stdin by default)" , outFile = def &= typFile &= help "Output file (stdout by default)" , batchSize = 10 &= help "Sent graphs in batches of the given size"@@ -224,7 +227,7 @@ , ignoreTags = False &= help "Ignore tags (compute segmentation-level accurracy)" , heedEos = False &= help "Pay attention to EOS markers (ignored by default)" , weak = False &= help "Compute weak accuracy rather than strong"- , discardProb0 = False &= help "Discard sentences with near 0 probability"+ -- , discardProb0 = False &= help "Discard sentences with near 0 probability" , verbose = False &= help "Print information about compared elements" } @@ -326,7 +329,7 @@ exec Tag{..} = do -- crf <- Pol.loadModel P.parseTag inModel- crf <- Pol.loadModel Pol.simplify4gsr Pol.simplify4dmb inModel+ crf <- Pol.loadModel Pol.simplify4gsr Pol.complexify4gsr Pol.simplify4dmb inModel -- inp <- DB.parseData <$> L.getContents inp <- DB.parseData <$> case inFile of Nothing -> getContentsUtf8@@ -366,7 +369,7 @@ exec Server{..} = do- crf <- Pol.loadModel Pol.simplify4gsr Pol.simplify4dmb inModel+ crf <- Pol.loadModel Pol.simplify4gsr Pol.complexify4gsr Pol.simplify4dmb inModel blackSet <- case blackFile of Nothing -> pure S.empty@@ -407,7 +410,7 @@ (L.splitOn "\n\n" inpAll) forM_ (map L.toStrict inputs) $ \inp -> do let req = Server.Request {dag = inp}- cfg = Server.ClientCfg {serverAddr=serverAddr}+ cfg = Server.ClientCfg {serverAddr=serverAddr, portNumber=port} Server.sendRequest cfg req >>= \case Nothing -> putStrLn "<< NO RESPONSE >>" Just Server.Answer{..} -> case outFile of@@ -442,7 +445,7 @@ , Acc.expandTag = expandTags , Acc.ignoreTag = ignoreTags , Acc.weakAcc = weak- , Acc.discardProb0 = discardProb0+ -- , Acc.discardProb0 = discardProb0 , Acc.verbose = verbose } stats <- Acc.collect cfg@@ -457,19 +460,36 @@ tagset <- parseTagset justTagsetPath <$> readFile justTagsetPath dags <- DB.parseData <$> readFileUtf8 dagPath forM_ dags $ \dag -> do- if (not $ DAG.isOK dag) then do- putStrLn "Incorrectly structured graph:"- showDAG dag- else if (not $ DAG.isDAG dag) then do- putStrLn "Graph with cycles:"- showDAG dag- else case verifyProb tagset dag of+ case verifyDAG tagset dag of Nothing -> return ()- Just p -> do- putStr "Probability equal to "- putStr (show p)- putStrLn ":"+ Just err -> do+ putStrLn (show err) showDAG dag+-- case err of+-- Malformed -> do+-- putStrLn "Incorrectly structured graph:"+-- showDAG dag+-- Cyclic -> do+-- putStrLn "Graph with cycles:"+-- showDAG dag+-- _ -> do+-- -- putStrLn "Another error:"+-- putStrLn (show err)+-- showDAG dag+--+-- if (not $ DAG.isOK dag) then do+-- putStrLn "Incorrectly structured graph:"+-- showDAG dag+-- else if (not $ DAG.isDAG dag) then do+-- putStrLn "Graph with cycles:"+-- showDAG dag+-- else case verifyProb tagset dag of+-- Nothing -> return ()+-- Just p -> do+-- putStr "Probability equal to "+-- putStr (show p)+-- putStrLn ":"+-- showDAG dag where showDAG dag = forM_ (DAG.dagEdges dag) $ \edgeID -> do@@ -481,15 +501,20 @@ putStr (show $ DAG.unNodeID to) putStr " => " T.putStrLn (PX.orth $ X.word val)- verifyProb tagset dag =+ verifyDAG tagset dag = let schema = Schema.fromConf Schema.nullConf rawData = Guess.schemed (Pol.simplify4gsr tagset) schema [PX.packSent dag] [encDag] = CRF.Codec.encodeDataL (CRF.Codec.mkCodec rawData) rawData- p = CRF.Train.dagProb encDag- eps = 1e-9- in if p >= 1 - eps && p <= 1 + eps- then Nothing- else Just p+ in CRF.Train.verifyDAG encDag+-- verifyProb tagset dag =+-- let schema = Schema.fromConf Schema.nullConf+-- rawData = Guess.schemed (Pol.simplify4gsr tagset) schema [PX.packSent dag]+-- [encDag] = CRF.Codec.encodeDataL (CRF.Codec.mkCodec rawData) rawData+-- p = CRF.Train.dagProb encDag+-- eps = 1e-9+-- in if p >= 1 - eps && p <= 1 + eps+-- then Nothing+-- else Just p exec Freqs{..} = do