crf-chain2-tiers 0.3.0 → 0.4.0

raw patch · 9 files changed

+118/−53 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• crf-chain2-tiers.cabal +1/−1
• src/Data/CRF/Chain2/Tiers/Core.hs +3/−3
• src/Data/CRF/Chain2/Tiers/DAG.hs +18/−16
• src/Data/CRF/Chain2/Tiers/DAG/Dataset/External.hs +1/−1
• src/Data/CRF/Chain2/Tiers/DAG/Inference.hs +69/−6
• src/Data/CRF/Chain2/Tiers/DAG/Probs.hs +11/−11
• src/Data/CRF/Chain2/Tiers/Dataset/Codec.hs +4/−4
• src/Data/CRF/Chain2/Tiers/Feature.hs +2/−2
• src/Data/CRF/Chain2/Tiers/Inference.hs +9/−9

@@ -1,5 +1,5 @@ name:               crf-chain2-tiers-version:            0.3.0+version:            0.4.0 synopsis:           Second-order, tiered, constrained, linear conditional random fields description:     The library provides implementation of the second-order, linear

@@ -54,12 +54,12 @@ import           Data.Ix (Ix) import           Data.Int (Int16, Int32) import           Data.List (zip4)-import qualified Data.Array.Unboxed as A+-- import qualified Data.Array.Unboxed as A import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import           Data.Vector.Unboxed.Deriving-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.Number.LogFloat as L -- import qualified Data.Primitive.ByteArray as BA 

@@ -15,7 +15,7 @@ -- , reTrain  -- * Tagging--- , tag+, tag , marginals , I.ProbType (..) , probs@@ -30,6 +30,7 @@ ) where  +import           Prelude hiding (Word) import           Control.Applicative ((<$>), (<*>)) import           Control.Monad (when) @@ -57,7 +58,7 @@ import qualified Data.CRF.Chain2.Tiers.DAG.Dataset.Codec as Codec import           Data.CRF.Chain2.Tiers.DAG.Dataset.Codec (Codec) import qualified Data.CRF.Chain2.Tiers.DAG.Feature as Feat-import           Data.CRF.Chain2.Tiers.DAG.Feature (Feat, FeatSel)+import           Data.CRF.Chain2.Tiers.DAG.Feature (Feat) import qualified Data.CRF.Chain2.Tiers.DAG.Inference as I import qualified Data.CRF.Chain2.Tiers.DAG.Probs as P @@ -204,8 +205,8 @@ --       report $ U.map (*0.1) para   where -    report para = do-      let crf = model {Model.values = para}+    report _para = do+      let crf = model {Model.values = _para}       llh <- show         . LogFloat.logFromLogFloat         . P.parLikelihood crf@@ -215,8 +216,8 @@         then show . I.accuracy crf <$> SGD.loadData evalData         else return "#"       putStrLn $ "[" ++ show (doneTotal k) ++ "] stats:"-      putStrLn $ "min(params) = " ++ show (U.minimum para)-      putStrLn $ "max(params) = " ++ show (U.maximum para)+      putStrLn $ "min(params) = " ++ show (U.minimum _para)+      putStrLn $ "max(params) = " ++ show (U.maximum _para)       putStrLn $ "log(likelihood(train)) = " ++ llh       putStrLn $ "acc(eval) = " ++ acc @@ -281,16 +282,17 @@ ----------------------------------------------------  --- -- | Find the most probable label sequence.--- tag :: (Ord a, Ord b) => CRF a b -> Sent a b -> [[b]]--- tag CRF{..} sent---     = onWords . decodeLabels codec---     . I.tag model . encodeSent codec---     $ sent---   where---     onWords xs =---         [ unJust codec word x---         | (word, x) <- zip sent xs ]+-- | Find the most probable labeled path.+tag :: (Ord a, Ord b) => CRF a b -> Sent a b -> DAG () (Maybe [b])+tag CRF{..} sent+  = fmap decodeChosen+  . DAG.zipE sent+  . I.fastTag' model+  . Codec.encodeSent codec+  $ sent+  where+    decodeChosen (word, chosen) = decode word <$> chosen+    decode word = Codec.unJust codec word . Codec.decodeLabel codec   -- | Tag labels with marginal probabilities.

@@ -6,7 +6,7 @@   import Prelude hiding (Word)-import qualified Data.DAG as DAG+-- import qualified Data.DAG as DAG import           Data.DAG (DAG)  import           Data.CRF.Chain2.Tiers.Dataset.External hiding (Sent, SentL)

@@ -6,6 +6,8 @@ ( tag , tag' , tagK+, fastTag+, fastTag' , marginals , marginals' , ProbType (..)@@ -35,9 +37,10 @@ import qualified Control.Parallel.Strategies as Par  import qualified Data.Number.LogFloat as L-import qualified Data.Vector as V-import qualified Data.Array as A+-- import qualified Data.Vector as V+-- import qualified Data.Array as A import qualified Data.Set as S+import qualified Data.Map.Strict as M import           Data.Maybe (fromJust) import qualified Data.MemoCombinators as Memo import qualified Data.List as List@@ -106,9 +109,9 @@   table (f Beg) (memo (f . Mid)) (f End)   where     memo = memoEdgeIx dag-    table b m e Beg = b-    table b m e (Mid x) = m x-    table b m e End = e+    table b _ _ Beg = b+    table _ m _ (Mid x) = m x+    table _ _ e End = e   memoEdgeIx :: DAG a b -> Memo.Memo EdgeIx@@ -153,6 +156,66 @@   ---------------------------------------------+-- NEW STUFF+---------------------------------------------+++-- | A version of `tag` which should be, roughly, twice as efficient, since it+-- only performs one `forward` and no `backward` computation.  The downside is+-- that probabilities cannot be retrieved.+fastTag :: Md.Model -> DAG a X -> DAG a (Maybe CbIx)+fastTag crf dag =+  DAG.mapE label dag+  where+    label edgeID _ = M.lookup edgeID selSet+    alpha = forward maximum crf dag+    selSet = rewind dag alpha+++-- | Similar to `fastTag` but directly returns complex labels and not just+-- their `CbIx` indexes.+fastTag' :: Md.Model -> DAG a X -> DAG a (Maybe Cb)+fastTag' crf dag+  = fmap (\(x, mayIx) -> C.lbAt x <$> mayIx)+  $ DAG.zipE dag (fastTag crf dag)+++rewind+  :: DAG a X   -- ^ The input DAG+  -> ProbArray -- ^ The forward probability table (pre-calculated with `max`)+  -> M.Map EdgeID CbIx -- ^ The optimal `EdgeIx`s+rewind dag alpha =++  best M.empty End++  where++    best m u = pick m $ argmax Beg [(w, alpha u w) | w <- prev u]++    prev End = Mid <$> Ft.finalEdgeIxs dag+    prev (Mid u) = complicate Beg <$> Ft.prevEdgeIxs dag (Just $ edgeID u)+    prev _ = error "DAG.Inference.rewind: impossible 1 happened"++    pick m (Mid u) = best (M.insert (edgeID u) (lbIx u) m) (Mid u)+    pick m Beg = m+    pick _ _ = error "DAG.Inference.rewind: impossible 2 happened"+++-- | Return the key with the highest corresponding value, with a default value+-- for the empty list.+argmax :: Ord v => k -> [(k, v)] -> k+argmax _def (x:xs) =+  go (fst x) (snd x) xs+  where+    go k v ((k', v') : rest)+      | v >= v' = go k v rest+      | otherwise = go k' v' rest+    go k _ [] = k+argmax def [] = def+{-# INLINE argmax #-}+++--------------------------------------------- -- A bit more complex stuff --------------------------------------------- @@ -513,7 +576,7 @@ accuracy :: Md.Model -> [DAG a (X, Y)] -> Double accuracy crf dataset =     let k = numCapabilities-    	parts = partition k dataset+        parts = partition k dataset         xs = Par.parMap Par.rseq (goodAndBad' crf) parts         (good, bad) = F.foldl' add (0, 0) xs         add (g, b) (g', b') = (g + g', b + b')

@@ -13,19 +13,19 @@  import           Control.Applicative ((<$>)) import qualified Control.Arrow as Arr-import qualified Control.Parallel as Par+-- import qualified Control.Parallel as Par import qualified Control.Parallel.Strategies as Par  import qualified Data.Number.LogFloat as L import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import qualified Data.Array as A-import qualified Data.Set as S-import           Data.Maybe (fromJust, maybeToList)-import qualified Data.MemoCombinators as Memo-import qualified Data.List as List-import           Data.Function (on)-import qualified Data.Foldable as F+-- import qualified Data.Vector.Unboxed as U+-- import qualified Data.Array as A+-- import qualified Data.Set as S+import           Data.Maybe (maybeToList)+-- import qualified Data.MemoCombinators as Memo+-- import qualified Data.List as List+-- import           Data.Function (on)+-- import qualified Data.Foldable as F  import           Data.DAG (EdgeID, DAG) import qualified Data.DAG as DAG@@ -35,13 +35,13 @@ import qualified Data.CRF.Chain2.Tiers.Model as Md import           Data.CRF.Chain2.Tiers.Util (partition) import           Data.CRF.Chain2.Tiers.DAG.Feature (EdgeIx(..))-import qualified Data.CRF.Chain2.Tiers.DAG.Feature as Ft+-- import qualified Data.CRF.Chain2.Tiers.DAG.Feature as Ft  import           Data.CRF.Chain2.Tiers.DAG.Inference                  (AccF, Pos(..), simplify, complicate, ProbArray) import qualified Data.CRF.Chain2.Tiers.DAG.Inference as I -import Debug.Trace (trace)+-- import Debug.Trace (trace)   --------------------------------------------

@@ -155,8 +155,8 @@     r' <- mapM encodeLbU (S.toList (lbs word))     let x = mkX x' r'     y  <- mkY <$> sequence-    	[ (,) <$> encodeLbU lb <*> pure pr-	| (lb, pr) <- (M.toList . unProb) choice ]+        [ (,) <$> encodeLbU lb <*> pure pr+        | (lb, pr) <- (M.toList . unProb) choice ]     return (x, y)  -- | Encodec the labeled word and do *not* update the codec.@@ -166,8 +166,8 @@     r' <- mapM encodeLbN (S.toList (lbs word))     let x = mkX x' r'     y  <- mkY <$> sequence-    	[ (,) <$> encodeLbN lb <*> pure pr-	| (lb, pr) <- (M.toList . unProb) choice ]+        [ (,) <$> encodeLbN lb <*> pure pr+        | (lb, pr) <- (M.toList . unProb) choice ]     return (x, y)  -- | Encode the word and update the codec.

@@ -22,9 +22,9 @@ ) where  -import           Control.Applicative ((<*>), (<$>))+-- import           Control.Applicative ((<*>), (<$>)) import           Data.Maybe (maybeToList)-import           Data.Binary (Binary, put, get)+-- import           Data.Binary (Binary, put, get) import qualified Data.Vector as V import qualified Data.Number.LogFloat as L 

@@ -72,10 +72,10 @@                 (\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+    withMem psi _alpha i j k         | i == -1 = 1.0         | otherwise = acc-            [ alpha (i - 1) k h * psi j+            [ _alpha (i - 1) k h * psi j             * onTransition crf sent i j k h             | h <- lbIxs sent (i - 2) ] @@ -85,10 +85,10 @@                (\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+    withMem psi _beta i j k         | i == V.length sent = 1.0         | otherwise = acc-            [ beta (i + 1) h j * psi h+            [ _beta (i + 1) h j * psi h             * onTransition crf sent i h j k             | h <- lbIxs sent i ] @@ -124,17 +124,17 @@                        (\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+    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+                  (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+    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+                  | otherwise = collectMaxArg (i + 1, h, j) (h:acc) _mem  -- | Find the most probable label sequence satisfying the constraints -- imposed over label values.