packages feed

crf-chain1-constrained 0.2.1 → 0.3.0

raw patch · 6 files changed

+98/−55 lines, 6 files

Files

crf-chain1-constrained.cabal view
@@ -1,5 +1,5 @@ name:               crf-chain1-constrained-version:            0.2.1+version:            0.3.0 synopsis:           First-order, constrained, linear-chain conditional random fields description:     The library provides efficient implementation of the first-order,
src/Data/CRF/Chain1/Constrained.hs view
@@ -11,20 +11,18 @@ , Sent , Prob (unProb) , mkProb-, WordL+, WordL (word, choice)+, mkWordL , SentL --- * CRF-, CRF (..)--- ** Training-, train -- ** Tagging , tag , tagK --- * Feature selection-, hiddenFeats-, presentFeats+-- * Modules+, module Data.CRF.Chain1.Constrained.Train+, module Data.CRF.Chain1.Constrained.Feature.Present+, module Data.CRF.Chain1.Constrained.Feature.Hidden ) where  import Data.CRF.Chain1.Constrained.Dataset.External
src/Data/CRF/Chain1/Constrained/Dataset/Codec.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE RecordWildCards #-}++ module Data.CRF.Chain1.Constrained.Dataset.Codec ( Codec , CodecM@@ -92,24 +95,24 @@  -- | Encode the labeled word and update the codec. encodeWordL'Cu :: (Ord a, Ord b) => WordL a b -> CodecM a b (X, Y)-encodeWordL'Cu (word, choice) = do-    x' <- mapM encodeObU (S.toList (obs word))-    r' <- mapM encodeLbU (S.toList (lbs word))+encodeWordL'Cu w = do+    x' <- mapM encodeObU $ S.toList $ obs $ word w+    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 ]+	| (lb, pr) <- (M.toList . unProb) (choice w) ]     return (x, y)  -- | Encodec the labeled word and do *not* update the codec. encodeWordL'Cn :: (Ord a, Ord b) => WordL a b -> CodecM a b (X, Y)-encodeWordL'Cn (word, choice) = do-    x' <- catMaybes <$> mapM encodeObN (S.toList (obs word))-    r' <- mapM encodeLbN (S.toList (lbs word))+encodeWordL'Cn w = do+    x' <- fmap catMaybes . mapM encodeObN . S.toList . obs $ word w+    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 ]+	| (lb, pr) <- (M.toList . unProb) (choice w) ]     return (x, y)  -- | Encode the word and update the codec.
src/Data/CRF/Chain1/Constrained/Dataset/External.hs view
@@ -4,7 +4,8 @@ , Sent , Prob (unProb) , mkProb-, WordL+, WordL (word, choice)+, mkWordL , SentL ) where @@ -24,7 +25,7 @@ -- | The word is considered to be unknown when the set of potential -- labels is empty. unknown :: Word a b -> Bool-unknown word = S.size (lbs word) == 0+unknown x = S.size (lbs x) == 0 {-# INLINE unknown #-}  -- | A sentence of words.@@ -48,11 +49,21 @@             let z = sum (M.elems dist)             in  fmap (/z) dist + -- | A WordL is a labeled word, i.e. a word with probability distribution -- defined over labels.  We assume that every label from the distribution -- domain is a member of the set of potential labels corresponding to the--- word.  TODO: Ensure the assumption using the smart constructor.-type WordL a b = (Word a b, Prob b)+-- word.  Use the `mkWordL` smart constructor to build `WordL`.+data WordL a b = WordL+    { word      :: Word a b+    , choice    :: Prob b }+++-- | Ensure, that every label from the distribution domain is a member+-- of the set of potential labels corresponding to the word.+mkWordL :: Word a b -> Prob b -> WordL a b+mkWordL = WordL+  -- | A sentence of labeled words. type SentL a b = [WordL a b]
src/Data/CRF/Chain1/Constrained/Model.hs view
@@ -54,14 +54,15 @@ notDummy = not . isDummy {-# INLINE notDummy #-} --- | The model is realy a map from features to potentials, but for the sake--- of efficiency the internal representation is more complex.+-- | The model is actually a map from features to their respective potentials,+-- but for the sake of efficiency the internal representation is more complex. data Model = Model {     -- | Value (potential) of the model for feature index.       values    :: U.Vector Double     -- | A map from features to feature indices     , ixMap     :: M.Map Feature FeatIx-    -- | Default set of potential labels.+    -- | A default set of labels.  It is used on sentence positions for which+    -- no constraints are assigned.     , r0        :: AVec Lb     -- | Singular feature index for the given label.  Index is equall to -1     -- if feature is not present in the model.
src/Data/CRF/Chain1/Constrained/Train.hs view
@@ -3,8 +3,17 @@   module Data.CRF.Chain1.Constrained.Train-( CRF (..)+(+-- * Model+  CRF (..)++-- * Training , train++-- * R0 construction+, oovChosen+, anyChosen+, anyInterps ) where  @@ -17,7 +26,8 @@ import qualified Numeric.SGD.LogSigned as L  import Data.CRF.Chain1.Constrained.Dataset.Internal-import Data.CRF.Chain1.Constrained.Dataset.External (SentL, unknown, unProb)+import Data.CRF.Chain1.Constrained.Dataset.External+    (SentL, WordL (..), lbs, unknown, unProb) import Data.CRF.Chain1.Constrained.Dataset.Codec     (mkCodec, Codec, obMax, lbMax, encodeDataL, encodeLabels) import Data.CRF.Chain1.Constrained.Feature (Feature, featuresIn)@@ -43,23 +53,25 @@   -- | Train the CRF using the stochastic gradient descent method.--- The resulting model will contain features extracted with--- the user supplied extraction function.--- You can use the functions provided by the "Data.CRF.Chain1.Feature.Present"--- and "Data.CRF.Chain1.Feature.Hidden" modules for this purpose.--- When the evaluation data 'IO' action is 'Just', the iterative--- training process will notify the user about the current accuracy--- on the evaluation part every full iteration over the training part.--- TODO: Accept custom r0 construction function.+--+-- The resulting model will contain features extracted with the user supplied+-- extraction function.  You can use the functions provided by the+-- "Data.CRF.Chain1.Constrained.Feature.Present" and+-- "Data.CRF.Chain1.Constrained.Feature.Hidden"+-- modules for this purpose.+--+-- You also have to supply R0 construction method (e.g. `oovChosen`)+-- which determines the contents of the default set of labels. train     :: (Ord a, Ord b)-    => SGD.SgdArgs                  -- ^ Args for SGD-    -> Bool                         -- ^ Store dataset on a disk-    -> IO [SentL a b]               -- ^ Training data 'IO' action-    -> IO [SentL a b]               -- ^ Evaluation data-    -> (AVec Lb -> [(Xs, Ys)] -> [Feature])     -- ^ Feature selection-    -> IO (CRF a b)                 -- ^ Resulting model-train sgdArgs onDisk trainIO evalIO extractFeats = do+    => SGD.SgdArgs                          -- ^ Args for SGD+    -> Bool                                 -- ^ Store dataset on a disk+    -> ([SentL a b] -> S.Set b)             -- ^ R0 construction+    -> (AVec Lb -> [(Xs, Ys)] -> [Feature]) -- ^ Feature selection+    -> IO [SentL a b]                       -- ^ Training data 'IO' action+    -> IO [SentL a b]                       -- ^ Evaluation data+    -> IO (CRF a b)                         -- ^ Resulting model+train sgdArgs onDisk mkR0 featSel trainIO evalIO = do     hSetBuffering stdout NoBuffering      -- Create codec and encode the training dataset@@ -72,10 +84,10 @@     SGD.withData onDisk evalData_ $ \evalData -> do      -- A default set of labels-    r0 <- encodeLabels codec . S.toList . unkSet <$> trainIO+    r0 <- encodeLabels codec . S.toList . mkR0 <$> trainIO      -- A set of features-    feats <- extractFeats r0 <$> SGD.loadData trainData+    feats <- featSel r0 <$> SGD.loadData trainData      -- Train the model     let model = (mkModel (obMax codec) (lbMax codec) feats) { r0 = r0 }@@ -85,18 +97,6 @@     return $ CRF codec (model { values = para })  --- | Collect labels assigned to unknown words (with empty list--- of potential interpretations).-unkSet :: Ord b => [SentL a b] -> S.Set b-unkSet =-    S.fromList . concatMap onSent-  where-    onSent = concatMap onWord-    onWord word-        | unknown (fst word)    = M.keys . unProb . snd $ word-        | otherwise             = []-- gradOn :: Model -> SGD.Para -> (Xs, Ys) -> SGD.Grad gradOn model para (xs, ys) = SGD.fromLogList $     [ (featToJustInt curr feat, L.fromPos val)@@ -127,3 +127,33 @@         = fromIntegral (i * batchSize)         / fromIntegral trainSize     trainSize = SGD.size trainData+++------------------------------------------------------+-- R0 construction+------------------------------------------------------+++-- | Collect labels assigned to OOV words.+oovChosen :: Ord b => [SentL a b] -> S.Set b+oovChosen = collect onWord where+    onWord x+        | unknown (word x)    = M.keys . unProb . choice $ x+        | otherwise             = []+++-- | Collect labels assigned to words in a dataset.+anyChosen :: Ord b => [SentL a b] -> S.Set b+anyChosen = collect $ M.keys . unProb . choice+++-- | Collect interpretations (also labels assigned) of words in a dataset.+anyInterps :: Ord b => [SentL a b] -> S.Set b+anyInterps = S.union+    <$> collect (S.toList . lbs . word)+    <*> anyChosen+++-- | Collect labels given function which selects labels from a word.+collect :: Ord b => (WordL a b -> [b]) -> [SentL a b] -> S.Set b+collect onWord = S.fromList . concatMap (concatMap onWord)