module Data.CRF.Chain2.Tiers.Feature
(
Feat (..)
, presentFeats
, hiddenFeats
, obFeatsOn
, trFeatsOn
, FeatSel
, selectPresent
, selectHidden
) where
import Control.Applicative ((<*>), (<$>))
import Data.Maybe (maybeToList)
import Data.Binary (Binary, put, get)
import qualified Data.Vector as V
import qualified Data.Number.LogFloat as L
import Data.CRF.Chain2.Tiers.Dataset.Internal
presentFeats :: Xs -> Ys -> [(Feat, L.LogFloat)]
presentFeats xs ys = concat
[ obFs i ++ trFs i
| i <- [0 .. V.length xs - 1] ]
where
obFs i =
[ (ft, pr)
| o <- unX (xs V.! i)
, (u, pr) <- unY (ys V.! i)
, ft <- obFeats o u ]
trFs 0 =
[ (ft, pr)
| (u, pr) <- unY (ys V.! 0)
, ft <- trFeats1 u ]
trFs 1 =
[ (ft, pr1 * pr2)
| (u, pr1) <- unY (ys V.! 1)
, (v, pr2) <- unY (ys V.! 0)
, ft <- trFeats2 u v ]
trFs i =
[ (ft, pr1 * pr2 * pr3)
| (u, pr1) <- unY (ys V.! i)
, (v, pr2) <- unY (ys V.! (i-1))
, (w, pr3) <- unY (ys V.! (i-2))
, ft <- trFeats3 u v w ]
hiddenFeats :: Xs -> [Feat]
hiddenFeats xs =
obFs ++ trFs
where
obFs = concat
[ obFeatsOn xs i u
| i <- [0 .. V.length xs - 1]
, u <- lbIxs xs i ]
trFs = concat
[ trFeatsOn 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 ]
obFeatsOn :: Xs -> Int -> CbIx -> [Feat]
obFeatsOn xs i u = concat
[ obFeats ob' e
| e <- lbs
, ob' <- unX (xs V.! i) ]
where
lbs = maybeToList (lbOn xs i u)
{-# INLINE obFeatsOn #-}
trFeatsOn :: Xs -> Int -> CbIx -> CbIx -> CbIx -> [Feat]
trFeatsOn 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 u v w
doIt (Just u) (Just v) _ = trFeats2 u v
doIt (Just u) _ _ = trFeats1 u
doIt _ _ _ = []
{-# INLINE trFeatsOn #-}
type FeatSel = Xs -> Ys -> [Feat]
selectPresent :: FeatSel
selectPresent xs = map fst . presentFeats xs
selectHidden :: FeatSel
selectHidden xs _ = hiddenFeats xs