diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -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 diff --git a/concraft-pl.cabal b/concraft-pl.cabal --- a/concraft-pl.cabal +++ b/concraft-pl.cabal @@ -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 diff --git a/src/NLP/Concraft/Polish/DAG/Server.hs b/src/NLP/Concraft/Polish/DAG/Server.hs --- a/src/NLP/Concraft/Polish/DAG/Server.hs +++ b/src/NLP/Concraft/Polish/DAG/Server.hs @@ -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 diff --git a/src/NLP/Concraft/Polish/DAGSeg.hs b/src/NLP/Concraft/Polish/DAGSeg.hs --- a/src/NLP/Concraft/Polish/DAGSeg.hs +++ b/src/NLP/Concraft/Polish/DAGSeg.hs @@ -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. diff --git a/tools/concraft-pl.hs b/tools/concraft-pl.hs --- a/tools/concraft-pl.hs +++ b/tools/concraft-pl.hs @@ -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