packages feed

crf-chain2-generic (empty) → 0.1.0

raw patch · 14 files changed

+1248/−0 lines, 14 filesdep +arraydep +basedep +binarysetup-changed

Dependencies added: array, base, binary, comonad-transformers, containers, data-lens, logfloat, monad-codec, parallel, sgd, vector, vector-binary

Files

+ Data/CRF/Chain2/Generic/Base.hs view
@@ -0,0 +1,91 @@+module Data.CRF.Chain2.Generic.Base+( AVec (unAVec)+, mkAVec+, AVec2 (unAVec2)+, mkAVec2++, X (_unX, _unR)+, Xs+, mkX+, unX+, unR+, lbAt++, Y (_unY)+, Ys+, mkY+, unY++, LbIx+) where++import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.Vector as V++-- | An index of the label.+type LbIx = Int++newtype AVec a = AVec { unAVec :: V.Vector a }+    deriving (Show, Read, Eq, Ord)++-- | Smart AVec constructor which ensures that the+-- underlying vector is strictly ascending.+mkAVec :: Ord a => [a] -> AVec a+mkAVec = AVec . V.fromList . S.toAscList  . S.fromList +{-# INLINE mkAVec #-}++newtype AVec2 a b = AVec2 { unAVec2 :: V.Vector (a, b) }+    deriving (Show, Read, Eq, Ord)++-- | Smart AVec constructor which ensures that the+-- underlying vector is strictly ascending with respect+-- to fst values.+mkAVec2 :: Ord a => [(a, b)] -> AVec2 a b+mkAVec2 = AVec2 . V.fromList . M.toAscList  . M.fromList +{-# INLINE mkAVec2 #-}++-- | A word represented by a list of its observations+-- and a list of its potential label interpretations.+data X o t = X+    { _unX :: AVec o+    , _unR :: AVec t }+    deriving (Show, Read, Eq, Ord)++-- | Sentence of words.+type Xs o t = V.Vector (X o t)++-- | X constructor.+mkX :: (Ord o, Ord t) => [o] -> [t] -> X o t+mkX x r  = X (mkAVec x) (mkAVec r)+{-# INLINE mkX #-}++-- | List of observations.+unX :: X o t -> [o]+unX = V.toList . unAVec . _unX+{-# INLINE unX #-}++-- | List of potential labels.+unR :: X o t -> [t]+unR = V.toList . unAVec . _unR+{-# INLINE unR #-}++lbAt :: X o t -> LbIx -> t+lbAt x = (unAVec (_unR x) V.!)+{-# INLINE lbAt #-}++newtype Y t = Y { _unY :: AVec2 t Double }+    deriving (Show, Read, Eq, Ord)++-- | Y constructor.+mkY :: Ord t => [(t, Double)] -> Y t+mkY = Y . mkAVec2+{-# INLINE mkY #-}++-- | Y deconstructor symetric to mkY.+unY :: Y t -> [(t, Double)]+unY = V.toList . unAVec2 . _unY+{-# INLINE unY #-}++-- | Sentence of Y (label choices).+type Ys t = V.Vector (Y t)
+ Data/CRF/Chain2/Generic/DP.hs view
@@ -0,0 +1,43 @@+module Data.CRF.Chain2.Generic.DP+( table+, flexible2+, flexible3+) where++import qualified Data.Array as A+import Data.Array ((!))+import Data.Ix (range)++table :: A.Ix i => (i, i) -> ((i -> e) -> i -> e) -> A.Array i e+table bounds f = table' where+    table' = A.listArray bounds+           $ map (f (table' !)) +           $ range bounds++down1 :: A.Ix i => (i, i) -> (i -> e) -> i -> e+down1 bounds f = (!) down' where+    down' = A.listArray bounds+          $ 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 ]++flexible2 :: (A.Ix i, A.Ix j) => (j, j) -> (j -> (i, i))  +          -> ((j -> i -> e) -> j -> i -> e) -> j -> i -> e+flexible2 bounds1 bounds2 f = (!) flex where+    flex = A.listArray bounds1+        [ down1 (bounds2 i) (f (flex !) i)+        | i <- range bounds1 ]++flexible3 :: (A.Ix j, A.Ix i, A.Ix k) => (k, k) -> (k -> (j, j))+          -> (k -> j -> (i, i)) -> ((k -> j -> i -> e) -> k -> j -> i -> e)+           -> k -> j -> i -> e+flexible3 bounds1 bounds2 bounds3 f = (!) flex where+    flex = A.listArray bounds1+        [ down2 (bounds2 i) (bounds3 i) (f (flex !) i)+        | i <- range bounds1 ]
+ Data/CRF/Chain2/Generic/External.hs view
@@ -0,0 +1,53 @@+module Data.CRF.Chain2.Generic.External+( Word (..)+, mkWord+, Sent+, Dist (unDist)+, mkDist+, WordL+, SentL+) where++import qualified Data.Set as S+import qualified Data.Map as M++-- | A word with 'a' representing the observation type and 'b' representing+-- the compound label type.+data Word a b = Word {+    -- | Set of observations.+      obs   :: S.Set a+    -- | Non-empty set of potential labels.+    , lbs   :: S.Set b }+    deriving (Show, Eq, Ord)++-- | A word constructor which checks non-emptiness of the potential+-- set of labels.+mkWord :: S.Set a -> S.Set b -> Word a b+mkWord _obs _lbs+    | S.null _lbs   = error "mkWord: empty set of potential labels"+    | otherwise     = Word _obs _lbs++type Sent a b = [Word a b]++-- | A probability distribution defined over elements of type a.+-- All elements not included in the map have probability equal+-- to 0.+newtype Dist a = Dist { unDist :: M.Map a Double }++-- | Construct the probability distribution.+mkDist :: Ord a => [(a, Double)] -> Dist a+mkDist =+    Dist . normalize . M.fromListWith (+)+  where+    normalize dist =+        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, Dist b)++-- | A sentence of labeled words.+type SentL a b = [WordL a b]
+ Data/CRF/Chain2/Generic/Inference.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE RecordWildCards #-}++module Data.CRF.Chain2.Generic.Inference+( tag+, probs+, marginals+, expectedFeatures+, accuracy+, zx+, zx'+) where++import Data.Ord (comparing)+import Data.List (maximumBy)+import qualified Data.Array as A+import qualified Data.Vector as V+import qualified Data.Number.LogFloat as L++import Control.Parallel.Strategies (rseq, parMap)+import Control.Parallel (par, pseq)+import GHC.Conc (numCapabilities)++import Data.CRF.Chain2.Generic.Base+import Data.CRF.Chain2.Generic.Model+import Data.CRF.Chain2.Generic.Util (partition)+import qualified Data.CRF.Chain2.Generic.DP as DP+++-- Interface on top of internal implementation++-- | Accumulation function.+type AccF = [L.LogFloat] -> L.LogFloat++type ProbArray = LbIx -> LbIx -> LbIx -> L.LogFloat++computePsi :: Ord f => Model o t f -> Xs o t -> Int -> LbIx -> L.LogFloat+computePsi crf xs i = (A.!) $ A.array (0, lbNum xs i - 1)+    [ (k, onWord crf xs i k)+    | k <- lbIxs xs i ]++forward :: Ord f => AccF -> Model o t f -> Xs o t -> ProbArray+forward acc crf sent = alpha where+    alpha = DP.flexible3 (-1, V.length sent - 1)+                (\i   -> (0, lbNum sent i - 1))+                (\i _ -> (0, lbNum sent (i - 1) - 1))+                (\t i -> withMem (computePsi crf sent i) t i)+    withMem psi alpha i j k+        | i == -1 = 1.0+        | otherwise = acc+            [ alpha (i - 1) k h * psi j+            * onTransition crf sent i j k h+            | h <- lbIxs sent (i - 2) ]++backward :: Ord f => AccF -> Model o t f -> Xs o t -> ProbArray+backward acc crf sent = beta where+    beta = DP.flexible3 (0, V.length sent)+               (\i   -> (0, lbNum sent (i - 1) - 1))+               (\i _ -> (0, lbNum sent (i - 2) - 1))+               (\t i -> withMem (computePsi crf sent i) t i)+    withMem psi beta i j k+        | i == V.length sent = 1.0+        | otherwise = acc+            [ beta (i + 1) h j * psi h+            * onTransition crf sent i h j k+            | h <- lbIxs sent i ]++zxBeta :: ProbArray -> L.LogFloat+zxBeta beta = beta 0 0 0++zxAlpha :: AccF -> Xs o t -> ProbArray -> L.LogFloat+zxAlpha acc sent alpha = acc+    [ alpha (n - 1) i j+    | i <- lbIxs sent (n - 1)+    , j <- lbIxs sent (n - 2) ]+    where n = V.length sent++zx :: Ord f => Model o t f -> Xs o t -> L.LogFloat+zx crf = zxBeta . backward sum crf++zx' :: Ord f => Model o t f -> Xs o t -> L.LogFloat+zx' crf sent = zxAlpha sum sent (forward sum crf sent)++argmax :: (Ord b) => (a -> b) -> [a] -> (a, b)+argmax f l = foldl1 choice $ map (\x -> (x, f x)) l+    where choice (x1, v1) (x2, v2)+              | v1 > v2 = (x1, v1)+              | otherwise = (x2, v2)++tagIxs :: Ord f => Model o t f -> Xs o t -> [Int]+tagIxs crf sent = collectMaxArg (0, 0, 0) [] mem where+    mem = DP.flexible3 (0, V.length sent)+                       (\i   -> (0, lbNum sent (i - 1) - 1))+                       (\i _ -> (0, lbNum sent (i - 2) - 1))+                       (\t i -> withMem (computePsi crf sent i) t i)+    withMem psiMem mem i j k+        | i == V.length sent = (-1, 1)+        | otherwise = argmax eval $ lbIxs sent i+        where eval h =+                  (snd $ mem (i + 1) h j) * psiMem h+                  * onTransition crf sent i h j k+    collectMaxArg (i, j, k) acc mem =+        collect $ mem i j k+        where collect (h, _)+                  | h == -1 = reverse acc+                  | otherwise = collectMaxArg (i + 1, h, j) (h:acc) mem++tag :: Ord f => Model o t f -> Xs o t -> [t]+tag crf sent =+    let ixs = tagIxs crf sent+    in  [lbAt x i | (x, i) <- zip (V.toList sent) ixs]++probs :: Ord f => Model o t f -> Xs o t -> [[L.LogFloat]]+probs crf sent =+    let alpha = forward maximum crf sent+        beta = backward maximum crf sent+        normalize xs =+            let d = - sum xs+            in map (*d) xs+        m1 k x = maximum+            [ alpha k x y * beta (k + 1) x y+            | y <- lbIxs sent (k - 1) ]+    in  [ normalize [m1 i k | k <- lbIxs sent i]+        | i <- [0 .. V.length sent - 1] ]++marginals :: Ord f => Model o t f -> Xs o t -> [[L.LogFloat]]+marginals crf sent =+    let alpha = forward sum crf sent+        beta = backward sum crf sent+    in  [ [ prob1 crf alpha beta sent i k+          | k <- lbIxs sent i ]+        | i <- [0 .. V.length sent - 1] ]++goodAndBad :: (Eq t, Ord f) => Model o t f -> Xs o t -> Ys t -> (Int, Int)+goodAndBad crf xs ys =+    foldl gather (0, 0) $ zip labels labels'+  where+    labels  = [ (best . unY) (ys V.! i)+              | i <- [0 .. V.length ys - 1] ]+    best zs+        | null zs   = Nothing+        | otherwise = Just . fst $ maximumBy (comparing snd) zs+    labels' = map Just $ tag crf xs+    gather (good, bad) (x, y)+        | x == y = (good + 1, bad)+        | otherwise = (good, bad + 1)++goodAndBad' :: (Eq t, Ord f) => Model o t f -> [(Xs o t, Ys t)] -> (Int, Int)+goodAndBad' crf dataset =+    let add (g, b) (g', b') = (g + g', b + b')+    in  foldl add (0, 0) [goodAndBad crf x y | (x, y) <- dataset]++-- | Compute the accuracy of the model with respect to the labeled dataset.+accuracy :: (Eq t, Ord f) => Model o t f -> [(Xs o t, Ys t)] -> Double+accuracy crf dataset =+    let k = numCapabilities+    	parts = partition k dataset+        xs = parMap rseq (goodAndBad' crf) parts+        (good, bad) = foldl add (0, 0) xs+        add (g, b) (g', b') = (g + g', b + b')+    in  fromIntegral good / fromIntegral (good + bad)++prob3+    :: Ord f => Model o t f -> ProbArray -> ProbArray -> Xs o t+    -> Int -> (LbIx -> L.LogFloat) -> LbIx -> LbIx -> LbIx+    -> L.LogFloat+prob3 crf alpha beta sent k psiMem x y z =+    alpha (k - 1) y z * beta (k + 1) x y * psiMem x+    * onTransition crf sent k x y z / zxBeta beta+{-# INLINE prob3 #-}++prob2+    :: Model o t f -> ProbArray -> ProbArray+    -> Xs o t -> Int -> LbIx -> LbIx -> L.LogFloat+prob2 _ alpha beta _ k x y =+    alpha k x y * beta (k + 1) x y / zxBeta beta+{-# INLINE prob2 #-}++prob1+    :: Model o t f -> ProbArray -> ProbArray+    -> Xs o t -> Int -> LbIx -> L.LogFloat+prob1 crf alpha beta sent k x = sum+    [ prob2 crf alpha beta sent k x y+    | y <- lbIxs sent (k - 1) ]++expectedFeaturesOn+    :: Ord f => Model o t f -> ProbArray -> ProbArray+    -> Xs o t -> Int -> [(f, L.LogFloat)]+expectedFeaturesOn crf alpha beta sent k =+    fs3 ++ fs1+    where psi = computePsi crf sent k+          pr1 = prob1 crf alpha beta sent k+          pr3 = prob3 crf alpha beta sent k psi+          fs1 = [ (ft, pr) +                | a <- lbIxs sent k+                , let pr = pr1 a+                , ft <- obFs a ]+    	  fs3 = [ (ft, pr) +                | a <- lbIxs sent k+                , b <- lbIxs sent $ k - 1+                , c <- lbIxs sent $ k - 2+                , let pr = pr3 a b c+                , ft <- trFs a b c ]+          obFs = obFeatsOn (featGen crf) sent k+          trFs = trFeatsOn (featGen crf) sent k++expectedFeatures :: Ord f => Model o t f -> Xs o t -> [(f, L.LogFloat)]+expectedFeatures crf sent =+    -- force parallel computation of alpha and beta tables+    zx1 `par` zx2 `pseq` zx1 `pseq` concat+      [ expectedFeaturesOn crf alpha beta sent k+      | k <- [0 .. V.length sent - 1] ]+    where alpha = forward sum crf sent+          beta = backward sum crf sent+          zx1 = zxAlpha sum sent alpha+          zx2 = zxBeta beta
+ Data/CRF/Chain2/Generic/Internal.hs view
@@ -0,0 +1,27 @@+module Data.CRF.Chain2.Generic.Internal+( lbNum+, lbOn+, lbIxs+) where++import qualified Data.Vector as V++import Data.CRF.Chain2.Generic.Base++lbVec :: Xs o t -> Int -> AVec t+lbVec xs = _unR . (xs V.!)+{-# INLINE lbVec #-}++-- | Number of potential labels on the given position of the sentence.+lbNum :: Xs o t -> Int -> Int+lbNum xs = V.length . unAVec . lbVec xs+{-# INLINE lbNum #-}++-- | Potential label on the given vector position.+lbOn :: Xs o t -> Int -> LbIx -> t+lbOn xs = (V.!) . unAVec . lbVec xs+{-# INLINE lbOn #-}++lbIxs :: Xs o t -> Int -> [LbIx]+lbIxs xs i = [0 .. lbNum xs i - 1]+{-# INLINE lbIxs #-}
+ Data/CRF/Chain2/Generic/Model.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE RecordWildCards #-}++module Data.CRF.Chain2.Generic.Model+( FeatIx (..)+, FeatGen (..)+, Model (..)+, mkModel+, Core (..)+, core+, withCore+, phi+, index+, presentFeats+, hiddenFeats+, obFeatsOn+, trFeatsOn+, onWord+, onTransition+, lbNum+, lbOn+, lbIxs+) where++import Control.Applicative ((<$>), (<*>))+import Data.Maybe (maybeToList)+import Data.Binary (Binary, put, get)+import Data.Vector.Binary ()+import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Generic.Base as G+import qualified Data.Vector.Generic.Mutable as G+import qualified Data.Number.LogFloat as L++import Data.CRF.Chain2.Generic.Base+import qualified Data.CRF.Chain2.Generic.Internal as I++-- | A feature index.  To every model feature a unique index is assigned.+newtype FeatIx = FeatIx { unFeatIx :: Int }+    deriving ( Show, Eq, Ord, Binary+             , G.Vector U.Vector, G.MVector U.MVector, U.Unbox )++-- | Feature generation specification.+data FeatGen o t f = FeatGen+    { obFeats   :: o -> t -> [f]+    , trFeats1  :: t -> [f]+    , trFeats2  :: t -> t -> [f]+    , trFeats3  :: t -> t -> t -> [f] }++-- | A conditional random field.+data Model o t f = Model+    { values    :: U.Vector Double+    , ixMap     :: M.Map f FeatIx+    , featGen   :: FeatGen o t f }++-- | A core of the model with no feature generation function.+-- Unlike the 'Model', the core can be serialized. +data Core f = Core+    { valuesC   :: U.Vector Double+    , ixMapC    :: M.Map f FeatIx }++instance (Ord f, Binary f) => Binary (Core f) where+    put Core{..} = put valuesC >> put ixMapC+    get = Core <$> get <*> get++-- | Extract the model core.+core :: Model o t f -> Core f+core Model{..} = Core values ixMap++-- | Construct model with the given core and feature generation function.+withCore :: Core f -> FeatGen o t f -> Model o t f+withCore Core{..} ftGen = Model valuesC ixMapC ftGen++-- | Features present in the dataset element together with corresponding+-- occurence probabilities.+presentFeats :: FeatGen o t f -> Xs o t -> Ys t -> [(f, L.LogFloat)]+presentFeats fg xs ys = concat+    [ obFs i ++ trFs i+    | i <- [0 .. V.length xs - 1] ]+  where+    obFs i =+        [ (ft, L.logFloat pr)+        | o <- unX (xs V.! i)+        , (u, pr) <- unY (ys V.! i)+        , ft <- obFeats fg o u ]+    trFs 0 =+        [ (ft, L.logFloat pr)+        | (u, pr) <- unY (ys V.! 0)+        , ft <- trFeats1 fg u ]+    trFs 1 =+        [ (ft, L.logFloat pr1 * L.logFloat pr2)+        | (u, pr1) <- unY (ys V.! 1)+        , (v, pr2) <- unY (ys V.! 0)+        , ft <- trFeats2 fg u v ]+    trFs i =+        [ (ft, L.logFloat pr1 * L.logFloat pr2 * L.logFloat pr3)+        | (u, pr1) <- unY (ys V.! i)+        , (v, pr2) <- unY (ys V.! (i-1))+        , (w, pr3) <- unY (ys V.! (i-2))+        , ft <- trFeats3 fg u v w ]++-- | Features hidden in the dataset element.+hiddenFeats :: FeatGen o t f -> Xs o t -> [f]+hiddenFeats fg xs =+    obFs ++ trFs+  where+    obFs = concat+        [ obFeatsOn fg xs i u+        | i <- [0 .. V.length xs - 1]+        , u <- lbIxs xs i ]+    trFs = concat+        [ trFeatsOn fg xs i u v w+        | i <- [0 .. V.length xs - 1]+        , u <- lbIxs xs i+        , v <- lbIxs xs $ i - 1+        , w <- lbIxs xs $ i - 2 ]++-- | FINISH: Dodać ekstrację liczby cech ze zbioru danych,+-- zmienić funkcję mkModel.+mkModel :: Ord f => FeatGen o t f -> [Xs o t] -> Model o t f+mkModel fg dataset = Model+    { values    = U.replicate (S.size fs) 0.0 +    , ixMap     =+        let featIxs = map FeatIx [0..]+            featLst = S.toList fs+        in  M.fromList (zip featLst featIxs)+    , featGen   = fg }+  where+    fs = S.fromList $ concatMap (hiddenFeats fg) dataset++-- | Potential assigned to the feature -- exponential of the+-- corresonding parameter.+phi :: Ord f => Model o t f -> f -> L.LogFloat+phi Model{..} ft = case M.lookup ft ixMap of+    Just ix -> L.logToLogFloat (values U.! unFeatIx ix)+    Nothing -> L.logToLogFloat (0 :: Float)+{-# INLINE phi #-}++-- | Index of the feature.+index :: Ord f => Model o t f -> f -> Maybe FeatIx+index Model{..} ft = M.lookup ft ixMap+{-# INLINE index #-}++obFeatsOn :: FeatGen o t f -> Xs o t -> Int -> LbIx -> [f]+obFeatsOn featGen xs i u = concat+    [ feats ob e+    | e  <- lbs+    , ob <- unX (xs V.! i) ]+  where +    feats   = obFeats featGen+    lbs     = maybeToList (lbOn xs i u)+{-# INLINE obFeatsOn #-}++trFeatsOn+    :: FeatGen o t f -> Xs o t -> Int+    -> LbIx -> LbIx -> LbIx -> [f]+trFeatsOn featGen xs i u' v' w' =+    doIt a b c+  where+    a = lbOn xs i       u'+    b = lbOn xs (i - 1) v'+    c = lbOn xs (i - 2) w'+    doIt (Just u) (Just v) (Just w) = trFeats3 featGen u v w+    doIt (Just u) (Just v) _        = trFeats2 featGen u v+    doIt (Just u) _ _               = trFeats1 featGen u+    doIt _ _ _                      = []+{-# INLINE trFeatsOn #-}++onWord :: Ord f => Model o t f -> Xs o t -> Int -> LbIx -> L.LogFloat+onWord crf xs i u =+    product . map (phi crf) $ obFeatsOn (featGen crf) xs i u+{-# INLINE onWord #-}++onTransition+    :: Ord f => Model o t f -> Xs o t -> Int+    -> LbIx -> LbIx -> LbIx -> L.LogFloat+onTransition crf xs i u w v =+    product . map (phi crf) $ trFeatsOn (featGen crf) xs i u w v+{-# INLINE onTransition #-}++lbNum :: Xs o t -> Int -> Int+lbNum xs i+    | i < 0 || i >= n   = 1+    | otherwise         = I.lbNum xs i+  where+    n = V.length xs+{-# INLINE lbNum #-}++lbOn :: Xs o t -> Int -> LbIx -> Maybe t+lbOn xs i+    | i < 0 || i >= n   = const Nothing+    | otherwise         = Just . I.lbOn xs i+  where+    n = V.length xs+{-# INLINE lbOn #-}++lbIxs :: Xs o t -> Int -> [LbIx]+lbIxs xs i+    | i < 0 || i >= n   = [0]+    | otherwise         = I.lbIxs xs i+  where+    n = V.length xs+{-# INLINE lbIxs #-}
+ Data/CRF/Chain2/Generic/Train.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternGuards #-}++module Data.CRF.Chain2.Generic.Train+( CodecSpc (..)+, train+) where++import System.IO (hSetBuffering, stdout, BufferMode (..))+import Control.Applicative ((<$>))+import Data.Maybe (maybeToList)+import qualified Data.Vector as V+import qualified Numeric.SGD as SGD+import qualified Numeric.SGD.LogSigned as L++import Data.CRF.Chain2.Generic.Base+import Data.CRF.Chain2.Generic.External (SentL)+import Data.CRF.Chain2.Generic.Model+import Data.CRF.Chain2.Generic.Inference (expectedFeatures, accuracy)++-- | A codec specification.+data CodecSpc a b c o t = CodecSpc+    { mkCodec :: [SentL a b] -> (c, [(Xs o t, Ys t)])+    , encode  :: c -> [SentL a b] -> [(Xs o t, Ys t)] }++-- | Train the CRF using the stochastic gradient descent method.+-- 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: Add custom feature extraction function.+train+    :: (Ord a, Ord b, Eq t, Ord f)+    => SGD.SgdArgs                  -- ^ Args for SGD+    -> CodecSpc a b c o t           -- ^ Codec specification+    -> FeatGen o t f                -- ^ Feature generation+    -> IO [SentL a b]               -- ^ Training data 'IO' action+    -> Maybe (IO [SentL a b])       -- ^ Maybe evalation data+    -> IO (c, Model o t f)          -- ^ Resulting codec and model+train sgdArgs CodecSpc{..} ftGen trainIO evalIO'Maybe = do+    hSetBuffering stdout NoBuffering+    (codec, trainData) <- mkCodec <$> trainIO+    evalDataM <- case evalIO'Maybe of+        Just evalIO -> Just . encode codec <$> evalIO+        Nothing     -> return Nothing+    let crf = mkModel ftGen (map fst trainData)+    para <- SGD.sgdM sgdArgs+        (notify sgdArgs crf trainData evalDataM)+        (gradOn crf) (V.fromList trainData) (values crf)+    return (codec, crf { values = para })++gradOn :: Ord f => Model o t f -> SGD.Para -> (Xs o t, Ys t) -> SGD.Grad+gradOn crf para (xs, ys) = SGD.fromLogList $+    [ (ix, L.fromPos val)+    | (ft, val) <- presentFeats (featGen curr) xs ys+    , FeatIx ix <- maybeToList (index curr ft) ] +++    [ (ix, L.fromNeg val)+    | (ft, val) <- expectedFeatures curr xs+    , FeatIx ix <- maybeToList (index curr ft) ]+  where+    curr = crf { values = para }++notify+    :: (Eq t, Ord f) => SGD.SgdArgs -> Model o t f -> [(Xs o t, Ys t)]+    -> Maybe [(Xs o t, Ys t)] -> SGD.Para -> Int -> IO ()+notify SGD.SgdArgs{..} crf trainData evalDataM para k +    | doneTotal k == doneTotal (k - 1) = putStr "."+    | Just dataSet <- evalDataM = do+        let x = accuracy (crf { values = para }) dataSet+        putStrLn ("\n" ++ "[" ++ show (doneTotal k) ++ "] f = " ++ show x)+    | otherwise =+        putStrLn ("\n" ++ "[" ++ show (doneTotal k) ++ "] f = #")+  where+    doneTotal :: Int -> Int+    doneTotal = floor . done+    done :: Int -> Double+    done i+        = fromIntegral (i * batchSize)+        / fromIntegral trainSize+    trainSize = length trainData
+ Data/CRF/Chain2/Generic/Util.hs view
@@ -0,0 +1,12 @@+module Data.CRF.Chain2.Generic.Util+( partition+) where++import Data.List (transpose)++partition :: Int -> [a] -> [[a]]+partition n =+    transpose . group n+  where+    group _ [] = []+    group k xs = take k xs : (group k $ drop k xs)
+ Data/CRF/Chain2/Pair.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE RecordWildCards #-}++module Data.CRF.Chain2.Pair+( CRF (..)+, train+, tag+) where++import Control.Applicative ((<$>), (<*>)) +import Data.Binary (Binary, get, put)+import qualified Numeric.SGD as SGD++import Data.CRF.Chain2.Generic.Model (Model, core, withCore)+import Data.CRF.Chain2.Generic.External (SentL, Sent)+import qualified Data.CRF.Chain2.Generic.Inference as I+import qualified Data.CRF.Chain2.Generic.Train as T++import Data.CRF.Chain2.Pair.Base+import Data.CRF.Chain2.Pair.Codec++data CRF a b c = CRF+    { codec :: Codec a b c+    , model :: Model Ob Lb Feat }++instance (Ord a, Ord b, Ord c, Binary a, Binary b, Binary c)+    => Binary (CRF a b c) where+    put CRF{..} = put codec >> put (core model)+    get = CRF <$> get <*> do+        _core <- get+        return $ withCore _core featGen++codecSpec :: (Ord a, Ord b, Ord c) => T.CodecSpc a (b, c) (Codec a b c) Ob Lb+codecSpec = T.CodecSpc+    { T.mkCodec = mkCodec+    , T.encode  = encodeDataL }++-- | Train the CRF using the stochastic gradient descent method.+-- 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: Add custom feature extraction function.+train+    :: (Ord a, Ord b, Ord c)+    => SGD.SgdArgs                  -- ^ Args for SGD+    -> IO [SentL a (b, c)]          -- ^ Training data 'IO' action+    -> Maybe (IO [SentL a (b, c)])  -- ^ Maybe evalation data+    -> IO (CRF a b c)               -- ^ Resulting codec and model+train sgdArgs trainIO evalIO'Maybe = do+    (_codec, _model) <- T.train+        sgdArgs+        codecSpec+        featGen+        trainIO+        evalIO'Maybe+    return $ CRF _codec _model++-- | Find the most probable label sequence.+tag :: (Ord a, Ord b, Ord c) => CRF a b c -> Sent a (b, c) -> [(b, c)]+tag CRF{..} sent+    = onWords . decodeLabels codec+    . I.tag model . encodeSent codec+    $ sent+  where+    onWords xs =+        [ unJust codec word x+        | (word, x) <- zip sent xs ]
+ Data/CRF/Chain2/Pair/Base.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Data.CRF.Chain2.Pair.Base+( Ob (..)+, Lb1 (..)+, Lb2 (..)+, Lb+, Feat (..)+, featGen+) where++import Control.Applicative ((<$>), (<*>)) +import Data.Binary (Binary, get, put, Put, Get)++import Data.CRF.Chain2.Generic.Model (FeatGen(..))++newtype Ob  = Ob  { unOb  :: Int } deriving (Show, Eq, Ord, Binary)+newtype Lb1 = Lb1 { unLb1 :: Int } deriving (Show, Eq, Ord, Binary)+newtype Lb2 = Lb2 { unLb2 :: Int } deriving (Show, Eq, Ord, Binary)+type Lb = (Lb1, Lb2)++data Feat+    = OFeat'1   {-# UNPACK #-} !Ob  {-# UNPACK #-} !Lb1+    | OFeat'2   {-# UNPACK #-} !Ob  {-# UNPACK #-} !Lb2+    | TFeat3'1  {-# UNPACK #-} !Lb1 {-# UNPACK #-} !Lb1 {-# UNPACK #-} !Lb1+    | TFeat3'2  {-# UNPACK #-} !Lb2 {-# UNPACK #-} !Lb2 {-# UNPACK #-} !Lb2+    | TFeat2'1  {-# UNPACK #-} !Lb1 {-# UNPACK #-} !Lb1+    | TFeat2'2  {-# UNPACK #-} !Lb2 {-# UNPACK #-} !Lb2+    | TFeat1'1  {-# UNPACK #-} !Lb1+    | TFeat1'2  {-# UNPACK #-} !Lb2+    deriving (Show, Eq, Ord)++instance Binary Feat where+    put (OFeat'1 o x)       = putI 0 >> put o >> put x+    put (OFeat'2 o x)       = putI 1 >> put o >> put x+    put (TFeat3'1 x y z)    = putI 2 >> put x >> put y >> put z+    put (TFeat3'2 x y z)    = putI 3 >> put x >> put y >> put z+    put (TFeat2'1 x y)      = putI 4 >> put x >> put y+    put (TFeat2'2 x y)      = putI 5 >> put x >> put y+    put (TFeat1'1 x)        = putI 6 >> put x+    put (TFeat1'2 x)        = putI 7 >> put x+    get = getI >>= \i -> case i of+        0   -> OFeat'1  <$> get <*> get+        1   -> OFeat'2  <$> get <*> get+        2   -> TFeat3'1 <$> get <*> get <*> get+        3   -> TFeat3'2 <$> get <*> get <*> get+        4   -> TFeat2'1 <$> get <*> get+        5   -> TFeat2'2 <$> get <*> get+        6   -> TFeat1'1 <$> get+        7   -> TFeat1'2 <$> get+        _   -> error "get feature: unknown code"++putI :: Int -> Put+putI = put+{-# INLINE putI #-}++getI :: Get Int+getI = get+{-# INLINE getI #-}++featGen :: FeatGen Ob (Lb1, Lb2) Feat+featGen = FeatGen+    { obFeats   = obFeats'+    , trFeats1  = trFeats1'+    , trFeats2  = trFeats2'+    , trFeats3  = trFeats3' }+  where+    obFeats' ob (x, y) =+        [ OFeat'1 ob x+        , OFeat'2 ob y ]+    trFeats1' (x, y) =+        [ TFeat1'1 x+        , TFeat1'2 y ]+    trFeats2' (x1, y1) (x2, y2) =+        [ TFeat2'1 x1 x2+        , TFeat2'2 y1 y2 ]+    trFeats3' (x1, y1) (x2, y2) (x3, y3) =+        [ TFeat3'1 x1 x2 x3+        , TFeat3'2 y1 y2 y3 ]
+ Data/CRF/Chain2/Pair/Codec.hs view
@@ -0,0 +1,293 @@+module Data.CRF.Chain2.Pair.Codec+( Codec+, CodecM+, obMax+, lb1Max+, lb2Max++, encodeWord'Cu+, encodeWord'Cn+, encodeSent'Cu+, encodeSent'Cn+, encodeSent++, encodeWordL'Cu+, encodeWordL'Cn+, encodeSentL'Cu+, encodeSentL'Cn+, encodeSentL++, decodeLabel+, decodeLabels+, unJust++, mkCodec+, encodeData+, encodeDataL+) where++import Control.Applicative (pure, (<$>), (<*>))+import Control.Comonad.Trans.Store (store)+import Data.Maybe (fromJust, catMaybes)+import Data.Lens.Common (Lens(..))+import qualified Data.Set as S+import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Control.Monad.Codec as C++import Data.CRF.Chain2.Pair.Base+import Data.CRF.Chain2.Generic.Base+import Data.CRF.Chain2.Generic.External++-- | A codec.  The first component is used to encode observations+-- of type a, the second one is used to encode labels of type b,+-- third -- labels of type c from the third level.+type Codec a b c =+    ( C.AtomCodec a+    , C.AtomCodec (Maybe b)+    , C.AtomCodec (Maybe c) )++_1 :: (a, b, c) -> a+_1 (x, _, _) = x+{-# INLINE _1 #-}++_2 :: (a, b, c) -> b+_2 (_, x, _) = x+{-# INLINE _2 #-}++_3 :: (a, b, c) -> c+_3 (_, _, x) = x+{-# INLINE _3 #-}++_1Lens :: Lens (a, b, c) a+_1Lens = Lens $ \(a, b, c) -> store (\a' -> (a', b, c)) a++_2Lens :: Lens (a, b, c) b+_2Lens = Lens $ \(a, b, c) -> store (\b' -> (a, b', c)) b++_3Lens :: Lens (a, b, c) c+_3Lens = Lens $ \(a, b, c) -> store (\c' -> (a, b, c')) c++-- | The maximum internal observation included in the codec.+obMax :: Codec a b c -> Ob+obMax =+    let idMax m = M.size m - 1+    in  Ob . idMax . C.to . _1++-- | The maximum internal label included in the codec.+lb1Max :: Codec a b c -> Lb1+lb1Max =+    let idMax m = M.size m - 1+    in  Lb1 . idMax . C.to . _2++-- | The maximum internal label included in the codec.+lb2Max :: Codec a b c -> Lb2+lb2Max =+    let idMax m = M.size m - 1+    in  Lb2 . idMax . C.to . _3++-- | The empty codec.  The label part is initialized with Nothing+-- member, which represents unknown labels.  It is taken on account+-- in the model implementation because it is assigned to the+-- lowest label code and the model assumes that the set of labels+-- is of the {0, ..., 'lbMax'} form.+empty :: (Ord b, Ord c) => Codec a b c+empty =+    ( C.empty+    , C.execCodec C.empty (C.encode C.idLens Nothing)+    , C.execCodec C.empty (C.encode C.idLens Nothing) )++-- | Type synonym for the codec monad.  It is important to notice that by a+-- codec we denote here a structure of three 'C.AtomCodec's while in the+-- monad-codec package it denotes a monad.+type CodecM a b c d = C.Codec (Codec a b c) d++-- | Encode the observation and update the codec (only in the encoding+-- direction).+encodeObU :: Ord a => a -> CodecM a b c Ob+encodeObU = fmap Ob . C.encode' _1Lens++-- | Encode the observation and do *not* update the codec.+encodeObN :: Ord a => a -> CodecM a b c (Maybe Ob)+encodeObN = fmap (fmap Ob) . C.maybeEncode _1Lens++-- | Encode the label and update the codec.+encodeLbU :: (Ord b, Ord c) => (b, c) -> CodecM a b c Lb+encodeLbU (x, y) = do+    x' <- C.encode _2Lens (Just x)+    y' <- C.encode _3Lens (Just y)+    return (Lb1 x', Lb2 y')++-- | Encode the label and do *not* update the codec.+encodeLbN :: (Ord b, Ord c) => (b, c) -> CodecM a b c Lb+encodeLbN (x, y) = do+    x' <- C.maybeEncode _2Lens (Just x) >>= \mx -> case mx of+        Just x' -> return x'+        Nothing -> fromJust <$> C.maybeEncode _2Lens Nothing+    y' <- C.maybeEncode _3Lens (Just y) >>= \my -> case my of+        Just y' -> return y'+        Nothing -> fromJust <$> C.maybeEncode _3Lens Nothing+    return (Lb1 x', Lb2 y')++-- | Encode the labeled word and update the codec.+encodeWordL'Cu+    :: (Ord a, Ord b, Ord c)+    => WordL a (b, c)+    -> CodecM a b c (X Ob Lb, Y Lb)+encodeWordL'Cu (word, choice) = do+    x' <- mapM encodeObU (S.toList (obs word))+    r' <- mapM encodeLbU (S.toList (lbs word))+    let x = mkX x' r'+    y  <- mkY <$> sequence+    	[ (,) <$> encodeLbU lb <*> pure pr+	| (lb, pr) <- (M.toList . unDist) choice ]+    return (x, y)++-- | Encodec the labeled word and do *not* update the codec.+encodeWordL'Cn+    :: (Ord a, Ord b, Ord c)+    => WordL a (b, c)+    -> CodecM a b c (X Ob Lb, Y Lb)+encodeWordL'Cn (word, choice) = do+    x' <- catMaybes <$> mapM encodeObN (S.toList (obs word))+    r' <- mapM encodeLbN (S.toList (lbs word))+    let x = mkX x' r'+    y  <- mkY <$> sequence+    	[ (,) <$> encodeLbN lb <*> pure pr+	| (lb, pr) <- (M.toList . unDist) choice ]+    return (x, y)++-- | Encode the word and update the codec.+encodeWord'Cu+    :: (Ord a, Ord b, Ord c)+    => Word a (b, c)+    -> CodecM a b c (X Ob Lb)+encodeWord'Cu word = do+    x' <- mapM encodeObU (S.toList (obs word))+    r' <- mapM encodeLbU (S.toList (lbs word))+    return $ mkX x' r'++-- | Encode the word and do *not* update the codec.+encodeWord'Cn+    :: (Ord a, Ord b, Ord c)+    => Word a (b, c)+    -> CodecM a b c (X Ob Lb)+encodeWord'Cn word = do+    x' <- catMaybes <$> mapM encodeObN (S.toList (obs word))+    r' <- mapM encodeLbN (S.toList (lbs word))+    return $ mkX x' r'++-- | Encode the labeled sentence and update the codec.+encodeSentL'Cu+    :: (Ord a, Ord b, Ord c)+    => SentL a (b, c)+    -> CodecM a b c (Xs Ob Lb, Ys Lb)+encodeSentL'Cu sent = do+    ps <- mapM (encodeWordL'Cu) sent+    return (V.fromList (map fst ps), V.fromList (map snd ps))++-- | Encode the labeled sentence and do *not* update the codec.+-- Substitute the default label for any label not present in the codec.+encodeSentL'Cn+    :: (Ord a, Ord b, Ord c)+    => SentL a (b, c)+    -> CodecM a b c (Xs Ob Lb, Ys Lb)+encodeSentL'Cn sent = do+    ps <- mapM (encodeWordL'Cn) sent+    return (V.fromList (map fst ps), V.fromList (map snd ps))++-- | Encode the labeled sentence with the given codec.  Substitute the+-- default label for any label not present in the codec.+encodeSentL+    :: (Ord a, Ord b, Ord c) => Codec a b c+    -> SentL a (b, c) -> (Xs Ob Lb, Ys Lb)+encodeSentL codec = C.evalCodec codec . encodeSentL'Cn++-- | Encode the sentence and update the codec.+encodeSent'Cu+    :: (Ord a, Ord b, Ord c) => Sent a (b, c)+    -> CodecM a b c (Xs Ob Lb)+encodeSent'Cu = fmap V.fromList . mapM encodeWord'Cu++-- | Encode the sentence and do *not* update the codec.+encodeSent'Cn+    :: (Ord a, Ord b, Ord c) => Sent a (b, c)+    -> CodecM a b c (Xs Ob Lb)+encodeSent'Cn = fmap V.fromList . mapM encodeWord'Cn++-- | Encode the sentence using the given codec.+encodeSent+    :: (Ord a, Ord b, Ord c) => Codec a b c+    -> Sent a (b, c) -> Xs Ob Lb+encodeSent codec = C.evalCodec codec . encodeSent'Cn++-- | Create the codec on the basis of the labeled dataset, return the+-- resultant codec and the encoded dataset.+mkCodec+    :: (Ord a, Ord b, Ord c) => [SentL a (b, c)]+    -> (Codec a b c, [(Xs Ob Lb, Ys Lb)])+mkCodec+    = swap+    . C.runCodec empty+    . mapM encodeSentL'Cu+  where+    swap (x, y) = (y, x)++-- | Encode the labeled dataset using the codec.  Substitute the default+-- label for any label not present in the codec.+encodeDataL+    :: (Ord a, Ord b, Ord c) => Codec a b c+    -> [SentL a (b, c)] -> [(Xs Ob Lb, Ys Lb)]+encodeDataL codec = C.evalCodec codec . mapM encodeSentL'Cn++-- | Encode the dataset with the codec.+encodeData+    :: (Ord a, Ord b, Ord c) => Codec a b c+    -> [Sent a (b, c)] -> [Xs Ob Lb]+encodeData codec = map (encodeSent codec)++-- | Decode the label within the codec monad.+decodeLabel'C+    :: (Ord b, Ord c) => Lb+    -> CodecM a b c (Maybe (b, c))+decodeLabel'C (x, y) = do+    x' <- C.decode _2Lens (unLb1 x)+    y' <- C.decode _3Lens (unLb2 y)+    return $ (,) <$> x' <*> y'++-- | Decode the label.+decodeLabel :: (Ord b, Ord c) => Codec a b c -> Lb -> Maybe (b, c)+decodeLabel codec = C.evalCodec codec . decodeLabel'C++-- | Decode the sequence of labels.+decodeLabels :: (Ord b, Ord c) => Codec a b c -> [Lb] -> [Maybe (b, c)]+decodeLabels codec = C.evalCodec codec . mapM decodeLabel'C++hasLabel :: (Ord b, Ord c) => Codec a b c -> (b, c) -> Bool+hasLabel codec (x, y)+    =  M.member (Just x) (C.to $ _2 codec)+    && M.member (Just y) (C.to $ _3 codec)+{-# INLINE hasLabel #-}++-- | Return the label when 'Just' or one of the unknown values+-- when 'Nothing'.+unJust+    :: (Ord b, Ord c) => Codec a b c+    -> Word a (b, c) -> Maybe (b, c)+    -> (b, c)+unJust _ _ (Just x) = x+unJust codec word Nothing = case allUnk of+    (x:_)   -> x+    []      -> error "unJust: Nothing and all values known"+  where+    allUnk = filter (not . hasLabel codec) (S.toList $ lbs word)++-- -- | Replace 'Nothing' labels with all unknown labels from+-- -- the set of potential interpretations.+-- unJusts :: Ord b => Codec a b -> Word a b -> [Maybe b] -> [b]+-- unJusts codec word xs =+--     concatMap deJust xs+--   where+--     allUnk = filter (not . hasLabel codec) (S.toList $ lbs word)+--     deJust (Just x) = [x]+--     deJust Nothing  = allUnk
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2011 Jakub Waszczuk, 2012 IPI PAN+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ crf-chain2-generic.cabal view
@@ -0,0 +1,55 @@+name:               crf-chain2-generic+version:            0.1.0+synopsis:           Second-order, generic, constrained, linear conditional random fields+description:+    The library provides implementation of the second-order, linear+    conditional random fields (CRFs) with position-wise constraints+    imposed over label values.  It provides a generic framework for+    defining custom feature data types and feature generation+    functions.+license:            BSD3+license-file:       LICENSE+cabal-version:      >= 1.6+copyright:          Copyright (c) 2011 Jakub Waszczuk, 2012 IPI PAN+author:             Jakub Waszczuk+maintainer:         waszczuk.kuba@gmail.com+stability:          experimental+category:           Math+homepage:           https://github.com/kawu/crf-chain2-generic+build-type:         Simple++library+    build-depends:+        base >= 4 && < 5+      , containers+      , array+      , vector+      , binary+      , vector-binary+      , logfloat+      , parallel+      , monad-codec >= 0.2 && < 0.3+      , data-lens+      , comonad-transformers+      , sgd >= 0.2.2 && < 0.3++    exposed-modules:+        Data.CRF.Chain2.Generic.Base+      , Data.CRF.Chain2.Generic.External+      , Data.CRF.Chain2.Generic.Model+      , Data.CRF.Chain2.Generic.Inference+      , Data.CRF.Chain2.Generic.Train+      , Data.CRF.Chain2.Pair.Base+      , Data.CRF.Chain2.Pair.Codec+      , Data.CRF.Chain2.Pair++    other-modules:+        Data.CRF.Chain2.Generic.Internal+      , Data.CRF.Chain2.Generic.DP+      , Data.CRF.Chain2.Generic.Util+        +    ghc-options: -Wall -O2++source-repository head+    type: git+    location: git://github.com/kawu/crf-chain2-generic.git