concraft 0.12.1 → 0.13.0

raw patch · 3 files changed

+59/−20 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• concraft.cabal +1/−1
• src/NLP/Concraft/DAG/Guess.hs +50/−15
• src/NLP/Concraft/DAGSeg.hs +8/−4

@@ -1,5 +1,5 @@ name:               concraft-version:            0.12.1+version:            0.13.0 synopsis:           Morphological disambiguation based on constrained CRFs description:     A morphological disambiguation library based on

@@ -62,8 +62,16 @@       -- ^ The tagset considered for the unknown words (TODO: a solution       -- parallel and not 100% consistent with what is implemented in the CRF       -- library)+      -- TODO: with `complexify`, `unkTagSet` is not needed anymore!     , simplify      :: t -> s       -- ^ A tag simplification function+    , complexify    :: s -> t+      -- ^ NEW: instead of an `unkTagSet`, a function which makes a complex tag+      -- out of a simple tag.+      --+      -- WARNING: we assume, that this function does not conflate simplified+      -- tags, i.e., tag to tags of type `s` cannot lead to one and the same+      -- complex tag of type `t`.     }  @@ -87,9 +95,13 @@  -- | Get the disambiguation model, provided the simplification function. -- getGuesser :: (M.Map t T.Tag) -> Get (Guesser t)-getGuesser :: (Binary t, Binary s, Ord s) => (t -> s) -> Get (Guesser t s)-getGuesser smp =-  Guesser <$> get <*> get <*> get <*> get <*> pure smp+getGuesser ::+     (Binary t, Binary s, Ord s, Ord t)+  => (t -> s)+  -> (s -> t)+  -> Get (Guesser t s)+getGuesser smp cpx =+  Guesser <$> get <*> get <*> get <*> get <*> pure smp <*> pure cpx   -- --------------------------@@ -154,12 +166,13 @@   . marginalsCRF cfg gsr   $ sent   where-    tags = X.mkWMap . M.toList . considerZero . choice+    tags = X.fromMap . considerZero . choice     -- we mix the chosen and the potential interpretations together     choice w = M.unionWith (+)       (CRF.unProb . CRF.choice $ w)-      (M.fromList . map (,0) . interps $ w)-    interps = S.toList . CRF.lbs . CRF.word+      -- (M.fromList . map (,0) . interps $ w)+      (M.fromSet (const 0) . interps $ w)+    interps = CRF.lbs . CRF.word     -- if empty, we choose the zero probability label.     considerZero m       | M.null m = M.singleton (zeroProbLab gsr) 0@@ -201,12 +214,16 @@   -> X.Sent w t   -> X.Sent w t inject gsr newSent srcSent =-  let doit (target, src) =-        let oldTags = if X.oov (X.word src)-                      then X.mkWMap . map (,0) . S.toList . unkTagSet $ gsr-                      else X.tags src-            newTags = injectWMap gsr target oldTags-        in  src {X.tags = newTags}+  let doit (target, src)+        | X.oov (X.word src) =+            let newTags = X.fromMap $ M.fromAscList+                  [ (complexify gsr tag, prob) +                  | (tag, prob) <- M.toAscList (X.unWMap target) ]+            in  src {X.tags = newTags}+        | otherwise =+            let oldTags = X.tags src+                newTags = injectWMap gsr target oldTags+            in  src {X.tags = newTags}   in  fmap doit (DAG.zipE newSent srcSent)  @@ -234,6 +251,9 @@     , maybe 0 id $       M.lookup (simplify gsr tag) (X.unWMap newSpl) )   | (tag, _) <- M.toList (X.unWMap src) ]+-- injectWMap gsr newSpl src = X.fromMap $ M.fromAscList+--   [ (complexify gsr smp, prob)+--   | (smp, prob) <- M.toAscList (X.unWMap newSpl) ]   -- --------------------------@@ -302,8 +322,11 @@     , zeroProbLabel :: t     -- | Label simplification function     , simplifyLabel :: t -> s-    -- | Strip the label from irrelevant information.  Used to determine othe set of-    -- possible tags for unknown words.+    -- | Label complexification function+    , complexifyLabel :: s -> t+    -- | Strip the label from irrelevant information.  Used to determine the+    -- set of possible tags for unknown words.+    -- TODO: we don't need this with `complexify` anymore!?     , stripLabel :: t -> t     -- | Guess only visible features     , onlyVisible :: Bool@@ -337,7 +360,14 @@     mkR0 featExtract     (schemed simplifyLabel schema <$> trainData)     (schemed simplifyLabel schema <$> evalData)-  return $ Guesser schemaConfT crf (simplifyLabel zeroProbLabel) tagSet simplifyLabel+  return $+    Guesser+      schemaConfT+      crf+      (simplifyLabel zeroProbLabel)+      tagSet+      simplifyLabel+      complexifyLabel   -- | Schematized dataset.@@ -365,3 +395,8 @@   | edgeID <- DAG.dagEdges dag   , let edge = DAG.edgeLabel edgeID dag   , tag <- M.keys . X.unWMap . X.tags $ edge ]+++-- | Compute the default `X.WMap` for unknown tags.+compUnkWMap :: Ord t => S.Set t -> X.WMap t+compUnkWMap = X.mkWMap . map (,0) . S.toList

@@ -108,18 +108,20 @@   :: (Ord t, Binary t)   => (P.Tagset -> t -> P.Tag)      -- ^ Guesser simplification function+  -> (P.Tagset -> P.Tag -> t)+     -- ^ Guesser complexification function   -> (P.Tagset -> t -> D.Tag)      -- ^ Segmentation/disamb simplification function (TODO: two different      -- simplification functions?)   -> Get (Concraft t)-getModel gsrSmp dmbSmp = do+getModel gsrSmp gsrCpx dmbSmp = do   comp <- get   when (comp /= modelVersion) $ error $     "Incompatible model version: " ++ comp ++     ", expected: " ++ modelVersion   tagset <- get   Concraft tagset <$> get-    <*> G.getGuesser (gsrSmp tagset)+    <*> G.getGuesser (gsrSmp tagset) (gsrCpx tagset)     <*> D.getDisamb (dmbSmp tagset)     <*> D.getDisamb (dmbSmp tagset) @@ -135,13 +137,15 @@   :: (Ord t, Binary t)   => (P.Tagset -> t -> P.Tag)      -- ^ Guesser simplification function+  -> (P.Tagset -> P.Tag -> t)+     -- ^ Guesser complexification function   -> (P.Tagset -> t -> D.Tag)      -- ^ Disamb simplification function   -> FilePath   -> IO (Concraft t)-loadModel gsrSmp dmbSmp path = do+loadModel gsrSmp gsrCpx dmbSmp path = do     -- x <- Binary.decode . GZip.decompress <$> BL.readFile path-    x <- runGet (getModel gsrSmp dmbSmp) . GZip.decompress <$> BL.readFile path+    x <- runGet (getModel gsrSmp gsrCpx dmbSmp) . GZip.decompress <$> BL.readFile path     x `seq` return x