crf-chain1-constrained 0.4.0 → 0.5.0

raw patch · 14 files changed

+121/−69 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• crf-chain1-constrained.cabal +2/−2
• src/Data/CRF/Chain1/Constrained/Core.hs +7/−1
• src/Data/CRF/Chain1/Constrained/DAG.hs +47/−7
• src/Data/CRF/Chain1/Constrained/DAG/Dataset/External.hs +1/−1
• src/Data/CRF/Chain1/Constrained/DAG/Feature/Hidden.hs +1/−1
• src/Data/CRF/Chain1/Constrained/DAG/Inference.hs +15/−15
• src/Data/CRF/Chain1/Constrained/DAG/Probs.hs +14/−13
• src/Data/CRF/Chain1/Constrained/DAG/Train.hs +5/−5
• src/Data/CRF/Chain1/Constrained/DP.hs +6/−6
• src/Data/CRF/Chain1/Constrained/Dataset/Codec.hs +9/−4
• src/Data/CRF/Chain1/Constrained/Feature/Hidden.hs +1/−1
• src/Data/CRF/Chain1/Constrained/Feature/Present.hs +1/−1
• src/Data/CRF/Chain1/Constrained/Inference.hs +9/−9
• src/Data/CRF/Chain1/Constrained/Model.hs +3/−3

@@ -1,5 +1,5 @@ name:               crf-chain1-constrained-version:            0.4.0+version:            0.5.0 synopsis:           First-order, constrained, linear-chain conditional random fields description:     The library provides efficient implementation of the first-order,@@ -24,7 +24,7 @@ license:            BSD3 license-file:       LICENSE cabal-version:      >= 1.6-copyright:          Copyright (c) 2012 IPI PAN+copyright:          Copyright (c) 2012-2018 Jakub Waszczuk, IPI PAN author:             Jakub Waszczuk maintainer:         waszczuk.kuba@gmail.com stability:          experimental

@@ -23,6 +23,7 @@ , AVec (..) , fromList , fromSet+, toAscList  -- * Features , Feature (..)@@ -78,6 +79,11 @@ fromSet = AVec . U.fromList . S.toAscList {-# INLINE fromSet #-} +-- | Convert AVec to an ascending list.+toAscList :: (Ord a, U.Unbox a) => AVec a -> [a]+toAscList = U.toList . unAVec+{-# INLINE toAscList #-}+ -- | A word represented by a list of its observations -- and a list of its potential label interpretations. data X@@ -166,7 +172,7 @@             0 -> SFeature <$> get             1 -> TFeature <$> get <*> get             2 -> OFeature <$> get <*> get-	    _ -> error "Binary Feature: unknown identifier"+            _ -> error "Binary Feature: unknown identifier"   -- | Is it a 'SFeature'?

@@ -1,4 +1,3 @@- {-# LANGUAGE RecordWildCards #-}  -- | The module provides first-order, linear-chain conditional random fields@@ -17,6 +16,7 @@ , SentL  -- ** Tagging+, Config (..) , tag , marginals -- , tagK@@ -28,13 +28,16 @@ ) where  import           Prelude hiding (Word)-import qualified Data.Vector as V+-- import qualified Data.Vector as V+import qualified Data.Set as S import qualified Data.Number.LogFloat as L  -- import qualified Data.CRF.Chain1.Constrained.DAG.Dataset.Internal as DAG import qualified Data.DAG as DAG import           Data.DAG (DAG) +import qualified Data.CRF.Chain1.Constrained.Core as Core+import qualified Data.CRF.Chain1.Constrained.Model as Model -- import           Data.CRF.Chain1.Constrained.Dataset.External import           Data.CRF.Chain1.Constrained.DAG.Dataset.External -- import           Data.CRF.Chain1.Constrained.DAG.Dataset.External (WordL(..))@@ -44,19 +47,32 @@ import           Data.CRF.Chain1.Constrained.DAG.Feature.Hidden import           Data.CRF.Chain1.Constrained.DAG.Train import qualified Data.CRF.Chain1.Constrained.DAG.Inference as I-import qualified Data.CRF.Chain1.Constrained.Dataset.Internal as Int+-- import qualified Data.CRF.Chain1.Constrained.Dataset.Internal as Int  +-- | Tagging configuration.+data Config a = Config+  { blackSet :: S.Set a+    -- ^ Blacklisted tags+  }++ -- | Determine the most probable label sequence within the context of the -- given sentence using the model provided by the 'CRF'.-tag :: (Ord a, Ord b) => CRF a b -> Sent a b -> DAG () b-tag CRF{..} sent+tag +  :: (Ord a, Ord b)+  => Config b+  -> CRF a b+  -> Sent a b+  -> DAG () b+tag Config{..} crf0 sent     = onWords     . fmap (decodeLabel codec)     . I.tag model     . C.encodeSent codec     $ sent   where+    CRF{..} = blackList blackSet crf0     -- handle unknown labels; otherwise, the type of `tag`s result     -- would be `DAG () (Maybe b)`     onWords labeled =@@ -73,14 +89,15 @@ -- (up to the way the set of all interpretations is constructed). -- In particular, if no interpretation with probability > 0 is found -- for an unknown word, its set of chosen labels will remain empty.-marginals :: (Ord a, Ord b) => CRF a b -> Sent a b -> SentL a b-marginals CRF{..} sent+marginals :: (Ord a, Ord b) => Config b -> CRF a b -> Sent a b -> SentL a b+marginals Config{..} crf0 sent   = fmap decodeChosen   . DAG.zipE sent   . I.marginals model   . C.encodeSent codec   $ sent   where+    CRF{..} = blackList blackSet crf0     decodeChosen (word, chosen) =       mkWordL word prob       where@@ -115,3 +132,26 @@ -- -- | Convert the sequential representation to DAG-based one. -- dagSent :: Int.Xs -> DAG.DAG () Int.X -- dagSent = DAG.fromList . V.toList+++------------------------------------------------------+-- Blacklisting tags+------------------------------------------------------+++-- | Blacklist the given set of tags, so that they are never proposed for+-- OOV segments.+blackList :: (Ord b) => S.Set b -> CRF a b -> CRF a b+blackList blackSet CRF{..} = CRF+  { codec = codec +  , model = newModel+  }+  where+    newModel = model {Model.r0 = newR0}+    r0Set = S.fromList . Core.toAscList $ Model.r0 model+    newR0 = Core.fromSet $ r0Set `S.difference` blackSetEncoded+    blackSetEncoded +      = S.fromList+      . map (C.encodeLabel codec)+      . S.toList+      $ blackSet

@@ -9,7 +9,7 @@ -- import qualified Data.Set as S -- import qualified Data.Map as M -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)

@@ -16,7 +16,7 @@ import           Data.DAG (DAG) import qualified Data.DAG as DAG -import           Data.CRF.Chain1.Constrained.Core (AVec, X, Y, Lb, Feature)+import           Data.CRF.Chain1.Constrained.Core (AVec, X, Lb, Feature) import qualified Data.CRF.Chain1.Constrained.Core as C  -- import Data.CRF.Chain1.Constrained.Dataset.Internal

@@ -24,7 +24,7 @@  import Control.Applicative ((<$>)) import Data.Maybe (catMaybes)-import Data.List (maximumBy, sort, sortBy)+import Data.List (maximumBy, sortBy) import Data.Function (on) import qualified Data.Set as S import qualified Data.Array as A@@ -50,7 +50,7 @@ import qualified Data.CRF.Chain1.Constrained.Core as C import qualified Data.CRF.Chain1.Constrained.Intersect as I -import           Data.CRF.Chain1.Constrained.DAG.Feature (featuresIn)+-- import           Data.CRF.Chain1.Constrained.DAG.Feature (featuresIn)  import Debug.Trace (trace) @@ -60,7 +60,7 @@ ---------------------------------------------  --- | TODO.+-- | Label index. type LbIx       = Int  @@ -168,7 +168,7 @@     [ i     | i <- DAG.dagEdges dag     , DAG.isInitialEdge i dag ]-  withMem psi alpha i+  withMem psi alpha' i     | i == snd bounds = const u'     | i `S.member` initialSet = \j ->         let x = lbOn crf (DAG.edgeLabel i dag) j@@ -178,22 +178,22 @@         in  psi j * ((u - v x) + w x)     where       u = safeSum-        [ alpha iMinus1 k+        [ alpha' iMinus1 k         | iMinus1 <- DAG.prevEdges i dag         , (k, _) <- lbIxs crf dag iMinus1 ]       v x = safeSum-        [ alpha iMinus1 k+        [ alpha' iMinus1 k         | iMinus1 <- DAG.prevEdges i dag         , (k, _) <- I.intersect (Md.prevIxs crf x) (lbVec crf dag iMinus1) ]       w x = safeSum-        [ alpha iMinus1 k * Md.valueL crf ix+        [ alpha' iMinus1 k * Md.valueL crf ix         | iMinus1 <- DAG.prevEdges i dag         , (k, ix) <- I.intersect (Md.prevIxs crf x) (lbVec crf dag iMinus1) ]       -- Note that if `i == snd bounds` then `i` does not refer to any existing       -- edge, hence the need to introduce `u'` which does almost the same thing       -- as `u`.       u' = safeSum-        [ alpha iMinus1 k+        [ alpha' iMinus1 k         | iMinus1 <- DAG.dagEdges dag         , DAG.isFinalEdge iMinus1 dag         , (k, _) <- lbIxs crf dag iMinus1 ]@@ -213,10 +213,10 @@     [ i     | i <- DAG.dagEdges dag     , DAG.isFinalEdge i dag ]-  withMem beta i+  withMem beta' i     | i `S.member` finalSet = const 1     | i == fst bounds = const $ safeSum-      [ beta iPlus1 k * psi iPlus1 k+      [ beta' iPlus1 k * psi iPlus1 k         * Md.sgValue crf (lbOn crf (DAG.edgeLabel iPlus1 dag) k)       | iPlus1 <- DAG.dagEdges dag       , DAG.isInitialEdge iPlus1 dag@@ -229,19 +229,19 @@       -- Instead of simply adding `1` to `i` (i.e., `i + 1`),       -- we need to find the identifiers of the succeeding edges.       u = safeSum-        [ beta iPlus1 k * psi iPlus1 k+        [ beta' iPlus1 k * psi iPlus1 k         | iPlus1 <- DAG.nextEdges i dag         , (k, _ ) <- lbIxs crf dag iPlus1 ]       -- `y` is the label on position `i`, we are looking for       -- matching labels on the position `i+1`.       v y = safeSum-        [ beta iPlus1 k * psi iPlus1 k+        [ beta' iPlus1 k * psi iPlus1 k         | iPlus1 <- DAG.nextEdges i dag         , (k, _ ) <- I.intersect (Md.nextIxs crf y) (lbVec crf dag iPlus1) ]       -- `y` is the label on position `i`, we are looking for       -- matching labels on the position `i+1`.       w y = safeSum-        [ beta iPlus1 k * psi iPlus1 k * Md.valueL crf ix+        [ beta' iPlus1 k * psi iPlus1 k * Md.valueL crf ix         | iPlus1 <- DAG.nextEdges i dag         , (k, ix) <- I.intersect (Md.nextIxs crf y) (lbVec crf dag iPlus1) ] @@ -288,7 +288,7 @@       error $ "edgeProb1: infinite -- " ++ show [up1, up2, down, down'] -- ++ "; " ++ show (k, x)   | otherwise = up1 * up2 / down   where-    isInf x = isInfinite (L.logFromLogFloat x :: Double)+    isInf v = isInfinite (L.logFromLogFloat v :: Double)     up1 = alpha k x     up2 = beta k x     down = zxBeta dag beta@@ -462,7 +462,7 @@ accuracy :: Md.Model -> [DAG a (X, Y)] -> Double accuracy crf dataset =     let k = numCapabilities-    	parts = partition k dataset+        parts = partition k dataset         xs = parMap rseq (goodAndBad' crf) parts         (good, bad) = F.foldl' add (0, 0) xs         add (g, b) (g', b') = (g + g', b + b')

@@ -12,18 +12,18 @@ ) where  -import Control.Applicative ((<$>))-import Data.Maybe (catMaybes)-import Data.List (maximumBy, sort, sortBy)-import Data.Function (on)+-- import Control.Applicative ((<$>))+-- import Data.Maybe (catMaybes)+-- import Data.List (maximumBy, sort, sortBy)+-- import Data.Function (on) import qualified Data.Set as S import qualified Data.Array as A -- import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U-import qualified Data.Foldable as F+-- import qualified Data.Foldable as F  import Control.Parallel.Strategies (rseq, parMap)-import Control.Parallel (par, pseq)+-- import Control.Parallel (par, pseq) import GHC.Conc (numCapabilities) import qualified Data.Number.LogFloat as L @@ -40,7 +40,7 @@ import qualified Data.CRF.Chain1.Constrained.Core as C import qualified Data.CRF.Chain1.Constrained.Intersect as I -import           Data.CRF.Chain1.Constrained.DAG.Feature (featuresIn)+-- import           Data.CRF.Chain1.Constrained.DAG.Feature (featuresIn) import qualified Data.CRF.Chain1.Constrained.DAG.Inference as Inf  @@ -66,8 +66,9 @@  -- | Vector of labels and the corresponding probabilities on the given edge of -- the sentence.+-- TODO: get rid of the _crf argument. lbVec :: Md.Model -> DAG a (X, Y) -> EdgeID -> AVec (Lb, Double)-lbVec crf dag edgeID =+lbVec _crf dag edgeID =   case DAG.edgeLabel edgeID dag of     (_, y) -> C._unY y {-# INLINE lbVec #-}@@ -134,7 +135,7 @@     [ i     | i <- DAG.dagEdges dag     , DAG.isInitialEdge i dag ]-  withMem psi alpha i+  withMem psi alpha' i     | i == snd bounds = const u'                    -- <= TO CHECK     | i `S.member` initialSet = \j ->         let (x, _) = lbOn crf dag i j@@ -144,23 +145,23 @@         in  psi j * ((u - v x) + w x)     where       u = safeSum-        [ alpha iMinus1 k+        [ alpha' iMinus1 k         | iMinus1 <- DAG.prevEdges i dag         , (k, _) <- lbIxs crf dag iMinus1 ]       v x = safeSum-        [ alpha iMinus1 k+        [ alpha' iMinus1 k         | iMinus1 <- DAG.prevEdges i dag         , (k, _) <-             I.intersect (Md.prevIxs crf x) (xify $ lbVec crf dag iMinus1) ]       w x = safeSum-        [ alpha iMinus1 k * Md.valueL crf ix+        [ alpha' iMinus1 k * Md.valueL crf ix         | iMinus1 <- DAG.prevEdges i dag         , (k, ix) <- I.intersect (Md.prevIxs crf x) (xify $ lbVec crf dag iMinus1) ]       -- Note that if `i == snd bounds` then `i` does not refer to any existing       -- edge, hence the need to introduce `u'` which does almost the same thing       -- as `u`.       u' = safeSum-        [ alpha iMinus1 k+        [ alpha' iMinus1 k         | iMinus1 <- DAG.dagEdges dag         , DAG.isFinalEdge iMinus1 dag         , (k, _) <- lbIxs crf dag iMinus1 ]

@@ -25,13 +25,13 @@   import Control.Applicative ((<$>), (<*>))-import qualified Control.Arrow as Arr+-- import qualified Control.Arrow as Arr import Control.Monad (when) import System.IO (hSetBuffering, stdout, BufferMode (..)) import Data.Binary (Binary, put, get) import qualified Data.Set as S import qualified Data.Map as M-import qualified Data.Vector as V+-- import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import qualified Data.Foldable as F import qualified Numeric.SGD.Momentum as SGD@@ -47,7 +47,7 @@ import           Data.CRF.Chain1.Constrained.Core (X, Y, Lb, AVec, Feature) import qualified Data.CRF.Chain1.Constrained.Core as C import qualified Data.CRF.Chain1.Constrained.Model as Md-import qualified Data.CRF.Chain1.Constrained.Dataset.Internal as Int+-- import qualified Data.CRF.Chain1.Constrained.Dataset.Internal as Int  import qualified Data.CRF.Chain1.Constrained.DAG.Dataset.Codec as Cd import qualified Data.CRF.Chain1.Constrained.DAG.Dataset.External as E@@ -157,8 +157,8 @@ --       report $ U.map (*0.5) para --       report $ U.map (*0.1) para   where-    report para = do-      let crf = model {Md.values = para}+    report paraNow = do+      let crf = model {Md.values = paraNow}       llh <- show         . LogFloat.logFromLogFloat         . P.parLikelihood crf

@@ -20,12 +20,12 @@           $ map f           $ range bounds -down2 :: (A.Ix i, A.Ix j) => (j, j) -> (j -> (i, i)) -> (j -> i -> e)-      -> j -> i -> e-down2 bounds1 bounds2 f = (!) down' where-    down' = A.listArray bounds1-        [ down1 (bounds2 i) (f i)-        | i <- range bounds1 ]+-- down2 :: (A.Ix i, A.Ix j) => (j, j) -> (j -> (i, i)) -> (j -> i -> e)+--       -> j -> i -> e+-- down2 bounds1 bounds2 f = (!) down' where+--     down' = A.listArray bounds1+--         [ down1 (bounds2 i) (f i)+--         | i <- range bounds1 ]  -- | 2-dimensional computation using dynamic programming. flexible2

@@ -20,6 +20,7 @@ , encodeSentL'Cn , encodeSentL +, encodeLabel , encodeLabels , decodeLabel , decodeLabels@@ -102,8 +103,8 @@     r' <- mapM encodeLbU $ S.toList $ lbs $ word w     let x = mkX x' r'     y  <- mkY <$> sequence-    	[ (,) <$> encodeLbU lb <*> pure pr-	| (lb, pr) <- (M.toList . unProb) (choice w) ]+        [ (,) <$> encodeLbU lb <*> pure pr+        | (lb, pr) <- (M.toList . unProb) (choice w) ]     return (x, y)  -- | Encodec the labeled word and do *not* update the codec.@@ -113,8 +114,8 @@     r' <- mapM encodeLbN . S.toList . lbs $ word w     let x = mkX x' r'     y  <- mkY <$> sequence-    	[ (,) <$> encodeLbN lb <*> pure pr-	| (lb, pr) <- (M.toList . unProb) (choice w) ]+        [ (,) <$> encodeLbN lb <*> pure pr+        | (lb, pr) <- (M.toList . unProb) (choice w) ]     return (x, y)  -- | Encode the word and update the codec.@@ -177,6 +178,10 @@ -- | Encode the dataset with the codec. encodeData :: (Ord a, Ord b) => Codec a b -> [Sent a b] -> [Xs] encodeData = map . encodeSent++-- | Encode the label.+encodeLabel :: Ord b => Codec a b -> b -> Lb+encodeLabel codec = C.evalCodec codec . encodeLbN  -- | Decode the label. decodeLabel :: Ord b => Codec a b -> Lb -> Maybe b

@@ -16,7 +16,7 @@ import qualified Data.Vector as V  import Data.CRF.Chain1.Constrained.Dataset.Internal-import Data.CRF.Chain1.Constrained.Feature+-- import Data.CRF.Chain1.Constrained.Feature  -- | Hidden 'OFeature's which can be constructed based on the dataset. -- The default set of potential interpretations is used for all unknown words.

@@ -15,7 +15,7 @@ import qualified Data.Vector as V  import Data.CRF.Chain1.Constrained.Dataset.Internal-import Data.CRF.Chain1.Constrained.Feature+-- import Data.CRF.Chain1.Constrained.Feature  -- | 'OFeature's which occur in the dataset. presentOFeats :: [(Xs, Ys)] -> [Feature]

@@ -78,7 +78,7 @@     bounds i         | i == V.length xs = (0, 0)         | otherwise = (0, lbNum crf xs i - 1)-    withMem psi alpha i+    withMem psi alpha' i         | i == V.length xs = const u         | i == 0 = \j ->             let x = lbOn crf (xs V.! i) j@@ -88,13 +88,13 @@             in  psi j * ((u - v x) + w x)       where         u = sum-            [ alpha (i-1) k+            [ alpha' (i-1) k             | (k, _) <- lbIxs crf xs (i-1) ]         v x = sum-            [ alpha (i-1) k+            [ alpha' (i-1) k             | (k, _) <- intersect (prevIxs crf x) (lbVec crf xs (i-1)) ]         w x = sum-            [ alpha (i-1) k * valueL crf ix+            [ alpha' (i-1) k * valueL crf ix             | (k, ix) <- intersect (prevIxs crf x) (lbVec crf xs (i-1)) ]  -- | Backward table computation.@@ -105,10 +105,10 @@     bounds i         | i == 0    = (0, 0)         | otherwise = (0, lbNum crf xs (i-1) - 1)-    withMem psi beta i+    withMem psi beta' i         | i == V.length xs = const 1         | i == 0 = const $ sum-            [ beta (i+1) k * psi k+            [ beta' (i+1) k * psi k             * sgValue crf (lbOn crf (xs V.! i) k)             | (k, _) <- lbIxs crf xs i ]         | otherwise = \j ->@@ -116,13 +116,13 @@             in  (u - v y) + w y       where         u = sum-            [ beta (i+1) k * psi k+            [ beta' (i+1) k * psi k             | (k, _ ) <- lbIxs crf xs i ]         v y = sum-            [ beta (i+1) k * psi k+            [ beta' (i+1) k * psi k             | (k, _ ) <- intersect (nextIxs crf y) (lbVec crf xs i) ]         w y = sum-            [ beta (i+1) k * psi k * valueL crf ix+            [ beta' (i+1) k * psi k * valueL crf ix             | (k, ix) <- intersect (nextIxs crf y) (lbVec crf xs i) ]  zxBeta :: ProbArray -> L.LogFloat

@@ -25,8 +25,8 @@ import Data.List (groupBy, sort) import Data.Function (on) import Data.Binary-import qualified Data.Vector.Generic.Base as G-import qualified Data.Vector.Generic.Mutable as G+-- import qualified Data.Vector.Generic.Base as G+-- import qualified Data.Vector.Generic.Mutable as G import qualified Data.Set as Set import qualified Data.Map as M import qualified Data.Vector.Unboxed as U@@ -71,7 +71,7 @@     , r0        :: AVec Lb     -- | Singular feature index for the given label.  Index is equall to -1     -- if feature is not present in the model.-    , sgIxsV 	:: U.Vector FeatIx+    , sgIxsV    :: U.Vector FeatIx     -- | Set of labels for the given observation which, together with the     -- observation, constitute an observation feature of the model.     , obIxsV    :: V.Vector (AVec LbIx)