diff --git a/crf-chain2-tiers.cabal b/crf-chain2-tiers.cabal
--- a/crf-chain2-tiers.cabal
+++ b/crf-chain2-tiers.cabal
@@ -1,5 +1,5 @@
 name:               crf-chain2-tiers
-version:            0.2.4
+version:            0.3.0
 synopsis:           Second-order, tiered, constrained, linear conditional random fields
 description:
     The library provides implementation of the second-order, linear
@@ -23,21 +23,24 @@
 
     build-depends:
         base                    >= 4            && < 5
-      , containers
-      , array
-      , vector
-      , binary
-      , vector-binary
+      , containers              >= 0.4          && < 0.6
+      , array                   >= 0.4          && < 0.6
+      , vector                  >= 0.10         && < 0.13
+      , binary                  >= 0.5          && < 0.9
+      , vector-binary           >= 0.1          && < 0.2
       , monad-codec             >= 0.2          && < 0.3
-      , data-lens               >= 2.10.4       && < 2.11
-      , comonad                 >= 4.0          && < 4.3
+      , data-lens               >= 2.10.4       && < 2.12
+      , comonad                 >= 4.0          && < 5.1
       , logfloat                >= 0.12.1       && < 0.14
-      , parallel
-      , sgd                     >= 0.3.2        && < 0.4
+      , parallel                >= 3.2          && < 3.3
+      , sgd                     >= 0.4          && < 0.5
       , vector-th-unbox         >= 0.2.1        && < 0.3
+      , pedestrian-dag          >= 0.2          && < 0.3
+      , data-memocombinators    >= 0.5          && < 0.6
 
     exposed-modules:
         Data.CRF.Chain2.Tiers
+      , Data.CRF.Chain2.Tiers.Core
       , Data.CRF.Chain2.Tiers.Dataset.Internal
       , Data.CRF.Chain2.Tiers.Dataset.External
       , Data.CRF.Chain2.Tiers.Dataset.Codec
@@ -45,6 +48,13 @@
       , Data.CRF.Chain2.Tiers.Model
       , Data.CRF.Chain2.Tiers.Inference
       , Data.CRF.Chain2.Tiers.Array
+
+      , Data.CRF.Chain2.Tiers.DAG
+      , Data.CRF.Chain2.Tiers.DAG.Feature
+      , Data.CRF.Chain2.Tiers.DAG.Dataset.External
+      , Data.CRF.Chain2.Tiers.DAG.Dataset.Codec
+      , Data.CRF.Chain2.Tiers.DAG.Inference
+      , Data.CRF.Chain2.Tiers.DAG.Probs
 
     other-modules:
         Data.CRF.Chain2.Tiers.Util
diff --git a/src/Data/CRF/Chain2/Tiers.hs b/src/Data/CRF/Chain2/Tiers.hs
--- a/src/Data/CRF/Chain2/Tiers.hs
+++ b/src/Data/CRF/Chain2/Tiers.hs
@@ -3,7 +3,7 @@
 
 
 module Data.CRF.Chain2.Tiers
-( 
+(
 -- * CRF
   CRF (..)
 , size
diff --git a/src/Data/CRF/Chain2/Tiers/Core.hs b/src/Data/CRF/Chain2/Tiers/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/CRF/Chain2/Tiers/Core.hs
@@ -0,0 +1,298 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+
+
+-- | Internal core data types.
+
+
+module Data.CRF.Chain2.Tiers.Core
+(
+-- * Basic types
+  Ob (..)
+, mkOb, unOb
+, Lb (..)
+, mkLb, unLb
+, FeatIx (..)
+, mkFeatIx, unFeatIx
+, CbIx
+
+-- * Complex label
+, Cb (..)
+, mkCb
+, unCb
+
+-- * Input element (word)
+, X (_unX, _unR)
+, mkX
+, unX
+, unR
+-- ** Indexing
+, lbAt
+
+-- * Output element (choice)
+, Y (_unY)
+, mkY
+, unY
+
+-- * Feature
+, Feat (..)
+-- ** Feature generation
+, obFeats
+, trFeats1
+, trFeats2
+, trFeats3
+) where
+
+
+import           Control.Applicative ((<$>), (<*>))
+import           Control.Arrow (second)
+
+import           Data.Binary (Binary, put, get, putWord8, getWord8)
+import           Data.Ix (Ix)
+import           Data.Int (Int16, Int32)
+import           Data.List (zip4)
+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.Number.LogFloat as L
+-- import qualified Data.Primitive.ByteArray as BA
+
+import           Data.CRF.Chain2.Tiers.Array (Bounds)
+
+----------------------------------------------------------------
+-- Basic types
+----------------------------------------------------------------
+
+
+-- | An observation.
+newtype Ob = Ob { _unOb :: Int32 }
+    deriving (Show, Eq, Ord, Binary)
+--           GeneralizedNewtypeDeriving doesn't work for this in 7.8.2:
+--           , G.Vector U.Vector, G.MVector U.MVector, U.Unbox )
+derivingUnbox "Ob" [t| Ob -> Int32 |] [| _unOb |] [| Ob |]
+
+-- | Smart observation constructor.
+mkOb :: Int -> Ob
+mkOb = Ob . fromIntegral
+{-# INLINE mkOb #-}
+
+
+-- | Deconstract observation.
+unOb :: Ob -> Int
+unOb = fromIntegral . _unOb
+{-# INLINE unOb #-}
+
+
+-- | An atomic label.
+newtype Lb = Lb { _unLb :: Int16 }
+    deriving (Show, Eq, Ord, Binary , Num, Ix, Bounds)
+derivingUnbox "Lb" [t| Lb -> Int16 |] [| _unLb |] [| Lb |]
+
+
+-- | Smart label constructor.
+mkLb :: Int -> Lb
+mkLb = Lb . fromIntegral
+{-# INLINE mkLb #-}
+
+
+-- | Deconstruct label.
+unLb :: Lb -> Int
+unLb = fromIntegral . _unLb
+{-# INLINE unLb #-}
+
+
+-- | An index of the label.
+type CbIx = Int
+
+
+-- | A feature index.  To every model feature a unique index is assigned.
+newtype FeatIx = FeatIx { _unFeatIx :: Int32 }
+    deriving (Show, Eq, Ord, Binary)
+derivingUnbox "FeatIx" [t| FeatIx -> Int32 |] [| _unFeatIx |] [| FeatIx |]
+
+-- | Smart feature index constructor.
+mkFeatIx :: Int -> FeatIx
+mkFeatIx = FeatIx . fromIntegral
+{-# INLINE mkFeatIx #-}
+
+
+-- | Deconstract feature index.
+unFeatIx :: FeatIx -> Int
+unFeatIx = fromIntegral . _unFeatIx
+{-# INLINE unFeatIx #-}
+
+
+----------------------------------------------------------------
+-- Complex label
+----------------------------------------------------------------
+
+
+-- TODO: Do we gain anything by representing the
+-- complex label with a byte array?  Complex labels
+-- should not be directly stored in a model, so if
+-- there is something to gain here, its not obvious.
+--
+-- Perhaps a list representation would be sufficient?
+
+
+-- -- | A complex label is an array of atomic labels.
+-- newtype Cb = Cb { unCb :: BA.ByteArray }
+
+
+-- | A complex label is a vector of atomic labels.
+newtype Cb = Cb { _unCb :: U.Vector Lb }
+    deriving (Show, Eq, Ord, Binary)
+
+
+-- | Smart complex label constructor.
+mkCb :: [Lb] -> Cb
+mkCb = Cb . U.fromList
+
+
+-- | Deconstract complex label.
+unCb :: Cb -> [Lb]
+unCb = U.toList . _unCb
+
+
+----------------------------------------------------------------
+-- Internal dataset representation
+----------------------------------------------------------------
+
+
+-- | A word is represented by a list of its observations
+-- and a list of its potential label interpretations.
+data X = X {
+    -- | A set of observations.
+      _unX :: U.Vector Ob
+    -- | A vector of potential labels.
+    , _unR :: V.Vector Cb }
+    deriving (Show, Eq, Ord)
+
+
+instance Binary X where
+    put X{..} = put _unX >> put _unR
+    get = X <$> get <*> get
+
+
+-- | Smart `X` constructor.
+mkX :: [Ob] -> [Cb] -> X
+mkX x r = X (U.fromList x) (V.fromList r)
+{-# INLINE mkX #-}
+
+
+-- | List of observations.
+unX :: X -> [Ob]
+unX = U.toList . _unX
+{-# INLINE unX #-}
+
+
+-- | List of potential labels.
+unR :: X -> [Cb]
+unR = V.toList . _unR
+{-# INLINE unR #-}
+
+
+-- | Potential label at the given position.
+lbAt :: X -> CbIx -> Cb
+lbAt x = (_unR x V.!)
+{-# INLINE lbAt #-}
+
+
+-- | Vector of chosen labels together with corresponding probabilities in log
+-- domain.
+newtype Y = Y { _unY :: V.Vector (Cb, Double) }
+    deriving (Show, Eq, Ord, Binary)
+
+
+-- | Y constructor.
+mkY :: [(Cb, Double)] -> Y
+mkY = Y . V.fromList . map (second log)
+{-# INLINE mkY #-}
+
+
+-- | Y deconstructor symetric to mkY.
+unY :: Y -> [(Cb, L.LogFloat)]
+unY = map (second L.logToLogFloat) . V.toList . _unY
+{-# INLINE unY #-}
+
+
+----------------------------------------------------------------
+-- Feature
+----------------------------------------------------------------
+
+
+-- | Feature; every feature is associated to a layer with `ln` identifier.
+data Feat
+    -- | Second-order transition feature.
+    = TFeat3
+        { x1    :: {-# UNPACK #-} !Lb
+        , x2    :: {-# UNPACK #-} !Lb
+        , x3    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    -- | First-order transition feature.
+    | TFeat2
+        { x1    :: {-# UNPACK #-} !Lb
+        , x2    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    -- | Zero-order transition feature.
+    | TFeat1
+        { x1    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    -- | Observation feature.
+    | OFeat
+        { ob    :: {-# UNPACK #-} !Ob
+        , x1    :: {-# UNPACK #-} !Lb
+        , ln    :: {-# UNPACK #-} !Int }
+    deriving (Show, Eq, Ord)
+
+
+instance Binary Feat where
+    put (OFeat o x k)       = putWord8 0 >> put o >> put x >> put k
+    put (TFeat3 x y z k)    = putWord8 1 >> put x >> put y >> put z >> put k
+    put (TFeat2 x y k)      = putWord8 2 >> put x >> put y >> put k
+    put (TFeat1 x k)        = putWord8 3 >> put x >> put k
+    get = getWord8 >>= \i -> case i of
+        0   -> OFeat  <$> get <*> get <*> get
+        1   -> TFeat3 <$> get <*> get <*> get <*> get
+        2   -> TFeat2 <$> get <*> get <*> get
+        3   -> TFeat1 <$> get <*> get
+        _   -> error "get feature: unknown code"
+
+
+----------------------------------------------------
+-- Features generation
+----------------------------------------------------
+
+
+-- | Generate observation features.
+obFeats :: Ob -> Cb -> [Feat]
+obFeats ob' xs =
+    [ OFeat ob' x k
+    | (x, k) <- zip (unCb xs) [0..] ]
+
+
+-- | Generate zero-order transition features.
+trFeats1 :: Cb -> [Feat]
+trFeats1 xs =
+    [ TFeat1 x k
+    | (x, k) <- zip (unCb xs) [0..] ]
+
+
+-- | Generate first-order transition features.
+trFeats2 :: Cb -> Cb -> [Feat]
+trFeats2 xs1 xs2 =
+    [ TFeat2 x1' x2' k
+    | (x1', x2', k) <- zip3 (unCb xs1) (unCb xs2) [0..] ]
+
+
+-- | Generate second-order transition features.
+trFeats3 :: Cb -> Cb -> Cb -> [Feat]
+trFeats3 xs1 xs2 xs3 =
+    [ TFeat3 x1' x2' x3' k
+    | (x1', x2', x3', k) <- zip4 (unCb xs1) (unCb xs2) (unCb xs3) [0..] ]
diff --git a/src/Data/CRF/Chain2/Tiers/DAG.hs b/src/Data/CRF/Chain2/Tiers/DAG.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/CRF/Chain2/Tiers/DAG.hs
@@ -0,0 +1,325 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TupleSections #-}
+
+
+module Data.CRF.Chain2.Tiers.DAG
+(
+-- * CRF
+  CRF (..)
+, size
+, prune
+
+-- * Training
+, train
+-- , reTrain
+
+-- * Tagging
+-- , tag
+, marginals
+, I.ProbType (..)
+, probs
+
+-- * Dataset
+, module Data.CRF.Chain2.Tiers.DAG.Dataset.External
+
+-- * Feature selection
+, Feat.FeatSel
+, Feat.selectHidden
+, Feat.selectPresent
+) where
+
+
+import           Control.Applicative ((<$>), (<*>))
+import           Control.Monad (when)
+
+import           System.IO (hSetBuffering, stdout, BufferMode (..))
+import           Data.Maybe (maybeToList)
+import qualified Data.Map.Strict as M
+import qualified Data.Set as S
+import           Data.Binary (Binary, get, put)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Number.LogFloat as LogFloat
+import qualified Numeric.SGD.Momentum as SGD
+import qualified Numeric.SGD.LogSigned as L
+import qualified Data.MemoCombinators as Memo
+
+import           Data.DAG (DAG)
+import qualified Data.DAG as DAG
+
+import           Data.CRF.Chain2.Tiers.Core (X, Y)
+import qualified Data.CRF.Chain2.Tiers.Core as Core
+import qualified Data.CRF.Chain2.Tiers.Model as Model
+import           Data.CRF.Chain2.Tiers.Model (Model)
+-- import qualified Data.CRF.Chain2.Tiers.DAG.Dataset.Internal as Int
+-- import qualified Data.CRF.Chain2.Tiers.Dataset.External as Ext
+import           Data.CRF.Chain2.Tiers.DAG.Dataset.External
+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 qualified Data.CRF.Chain2.Tiers.DAG.Inference as I
+import qualified Data.CRF.Chain2.Tiers.DAG.Probs as P
+
+
+----------------------------------------------------
+-- CRF model
+----------------------------------------------------
+
+
+-- | CRF model data.
+data CRF a b = CRF
+    { numOfLayers   :: Int
+    , codec         :: Codec a b
+    , model         :: Model }
+
+
+instance (Ord a, Ord b, Binary a, Binary b) => Binary (CRF a b) where
+    put CRF{..} = put numOfLayers >> put codec >> put model
+    get = CRF <$> get <*> get <*> get
+
+
+-- | Compute size (number of features) of the model.
+size :: CRF a b -> Int
+size CRF{..} = M.size (Model.toMap model)
+
+
+-- | Discard model features with absolute values (in log-domain)
+-- lower than the given threshold.
+prune :: Double -> CRF a b -> CRF a b
+prune x crf =  crf { model = newModel } where
+    newModel = Model.fromMap . M.fromList $
+        [ (feat, val)
+        | (feat, val) <- M.toList $ Model.toMap (model crf)
+        , abs (LogFloat.logFromLogFloat val) > x ]
+
+
+-- | Construct model from a dataset given a feature selection function.
+mkModel :: (DAG a (X, Y) -> [Feat]) -> [DAG a (X, Y)] -> Model
+mkModel featSel
+  = Model.fromSet . S.fromList
+  . concatMap featSel -- (map fst . Feat.presentFeats)
+
+
+----------------------------------------------------
+-- Training
+----------------------------------------------------
+
+
+-- | Train the CRF using the stochastic gradient descent method.
+train
+  :: (Ord a, Ord b)
+  => Int                          -- ^ Number of layers (tiers)
+  -> Feat.FeatSel ()              -- ^ Feature selection
+  -> SGD.SgdArgs                  -- ^ SGD parameters
+  -> Bool                         -- ^ Store dataset on a disk
+  -> IO [SentL a b]               -- ^ Training data 'IO' action
+  -> IO [SentL a b]               -- ^ Evaluation data
+  -> IO (CRF a b)                 -- ^ Resulting model
+train numOfLayers featSel sgdArgs onDisk trainIO evalIO = do
+    hSetBuffering stdout NoBuffering
+
+    -- Create codec and encode the training dataset
+    codec <- Codec.mkCodec numOfLayers    <$> trainIO
+    trainData_ <- Codec.encodeDataL codec <$> trainIO
+    let trainLenOld = length trainData_
+        trainData0 = verifyDataset trainData_
+        trainLenNew = length trainData0
+    -- mapM_ print $ map dagProb trainData_
+    when (trainLenNew < trainLenOld) $ do
+      putStrLn $ "Discarded "
+        ++ show (trainLenOld - trainLenNew) ++ "/" ++ show trainLenOld
+        ++  " elements from the training dataset"
+    SGD.withData onDisk trainData0 $ \trainData -> do
+    -- SGD.withData onDisk trainData_ $ \trainData -> do
+
+    -- Encode the evaluation dataset
+    evalData_ <- Codec.encodeDataL codec <$> evalIO
+    SGD.withData onDisk evalData_ $ \evalData -> do
+
+    -- Train the model
+    model <- mkModel featSel <$> SGD.loadData trainData
+    para  <- SGD.sgd sgdArgs
+        (notify sgdArgs model trainData evalData)
+        (gradOn model) trainData (Model.values model)
+    return $ CRF numOfLayers codec model { Model.values = para }
+
+
+-- -- | Re-train the CRF using the stochastic gradient descent method.
+-- reTrain
+--     :: (Ord a, Ord b)
+--     => CRF a b                      -- ^ Existing CRF model
+--     -> SGD.SgdArgs                  -- ^ SGD parameters
+--     -> Bool                         -- ^ Store dataset on a disk
+--     -> IO [SentL a b]               -- ^ Training data 'IO' action
+--     -> IO [SentL a b]               -- ^ Evaluation data
+--     -> IO (CRF a b)                 -- ^ Resulting model
+-- reTrain crf sgdArgs onDisk trainIO evalIO = do
+--     hSetBuffering stdout NoBuffering
+--
+--     -- Encode the training dataset
+--     trainData_ <- encodeDataL (codec crf) <$> trainIO
+--     SGD.withData onDisk trainData_ $ \trainData -> do
+--
+--     -- Encode the evaluation dataset
+--     evalData_ <- encodeDataL (codec crf) <$> evalIO
+--     SGD.withData onDisk evalData_ $ \evalData -> do
+--
+--     -- Train the model
+--     let model' = model crf
+--     para  <- SGD.sgd sgdArgs
+--         (notify sgdArgs model' trainData evalData)
+--         (gradOn model') trainData (values model')
+--     return $ crf { model = model' { values = para } }
+
+
+-- | Compute gradient on a dataset element.
+gradOn :: Model -> SGD.Para -> DAG a (X, Y) -> SGD.Grad
+-- gradOn model para (xs, ys) = SGD.fromLogList $
+gradOn model para dag = SGD.fromLogList $
+    [ (Core.unFeatIx ix, L.fromPos val)
+    | (ft, val) <- Feat.presentFeats dag
+    , ix <- maybeToList (Model.index curr ft) ] ++
+    [ (Core.unFeatIx ix, L.fromNeg val)
+    | (ft, val) <- I.expectedFeaturesIn curr (fmap fst dag)
+    , ix <- maybeToList (Model.index curr ft) ]
+  where
+    curr = model { Model.values = para }
+
+
+notify
+    :: SGD.SgdArgs -> Model
+    -> SGD.Dataset (DAG a (X, Y))         -- ^ Training dataset
+    -> SGD.Dataset (DAG a (X, Y))         -- ^ Evaluaion dataset
+    -> SGD.Para -> Int -> IO ()
+notify SGD.SgdArgs{..} model trainData evalData para k
+  | doneTotal k == doneTotal (k - 1) = putStr "."
+  | otherwise = do
+      putStrLn "" >> report para
+--       report $ U.map (*50.0) para
+--       report $ U.map (*10.0) para
+--       report $ U.map (*2.0) para
+--       report $ U.map (*0.9) para
+--       report $ U.map (*0.5) para
+--       report $ U.map (*0.1) para
+  where
+
+    report para = do
+      let crf = model {Model.values = para}
+      llh <- show
+        . LogFloat.logFromLogFloat
+        . P.parLikelihood crf
+        <$> SGD.loadData trainData
+      acc <-
+        if SGD.size evalData > 0
+        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 $ "log(likelihood(train)) = " ++ llh
+      putStrLn $ "acc(eval) = " ++ acc
+
+--     report para = do
+--       acc <-
+--         if SGD.size evalData > 0
+--         then show . I.accuracy (model { Model.values = para }) <$> SGD.loadData evalData
+--         else return "#"
+--       putStrLn $
+--         "[" ++ show (doneTotal k) ++ "] acc = " ++ acc ++
+--         ", min(params) = " ++ show (U.minimum para) ++
+--         ", max(params) = " ++ show (U.maximum para)
+
+    doneTotal :: Int -> Int
+    doneTotal = floor . done
+    done :: Int -> Double
+    done i
+        = fromIntegral (i * batchSize)
+        / fromIntegral trainSize
+    trainSize = SGD.size trainData
+
+------------------------------------------------------
+-- Verification
+------------------------------------------------------
+
+
+-- | Compute the probability of the DAG, based on the probabilities assigned to
+-- different edges and their labels.
+dagProb :: DAG a (X, Y) -> Double
+dagProb dag = sum
+  [ fromEdge edgeID
+  | edgeID <- DAG.dagEdges dag
+  , DAG.isInitialEdge edgeID dag ]
+  where
+    fromEdge =
+      Memo.wrap DAG.EdgeID DAG.unEdgeID Memo.integral fromEdge'
+    fromEdge' edgeID
+      = edgeProb edgeID
+      * fromNode (DAG.endsWith edgeID dag)
+    edgeProb edgeID =
+      let (_x, y) = DAG.edgeLabel edgeID dag
+      in  sum . map (LogFloat.fromLogFloat . snd) $ Core.unY y
+    fromNode nodeID =
+      case DAG.outgoingEdges nodeID dag of
+        [] -> 1
+        xs -> sum (map fromEdge xs)
+
+
+-- | Filter out sentences with `dagProb` different from 1.
+verifyDataset :: [DAG a (X, Y)] -> [DAG a (X, Y)]
+verifyDataset =
+  filter verify
+  where
+    verify dag =
+      let p = dagProb dag
+      in  p >= 1 - eps && p <= 1 + eps
+    eps = 1e-9
+
+
+----------------------------------------------------
+-- Tagging
+----------------------------------------------------
+
+
+-- -- | 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 ]
+
+
+-- | Tag labels with marginal probabilities.
+marginals :: (Ord a, Ord b) => CRF a b -> Sent a b -> SentL a b
+marginals CRF{..} sent
+  = fmap decodeChosen
+  . DAG.zipE sent
+  . I.marginals' model
+  . Codec.encodeSent codec
+  $ sent
+  where
+    decodeChosen (word, chosen) = (word,) $ mkProb
+      [ (decode word x, LogFloat.fromLogFloat p)
+      | (x, p) <- chosen ]
+      where
+    decode word = Codec.unJust codec word . Codec.decodeLabel codec
+
+
+-- | Tag labels with marginal probabilities.
+probs :: (Ord a, Ord b) => I.ProbType -> CRF a b -> Sent a b -> SentL a b
+probs probTyp CRF{..} sent
+  = fmap decodeChosen
+  . DAG.zipE sent
+  . I.probs' probTyp model
+  . Codec.encodeSent codec
+  $ sent
+  where
+    decodeChosen (word, chosen) = (word,) $ mkProb
+      [ (decode word x, LogFloat.fromLogFloat p)
+      | (x, p) <- chosen ]
+      where
+    decode word = Codec.unJust codec word . Codec.decodeLabel codec
diff --git a/src/Data/CRF/Chain2/Tiers/DAG/Dataset/Codec.hs b/src/Data/CRF/Chain2/Tiers/DAG/Dataset/Codec.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/CRF/Chain2/Tiers/DAG/Dataset/Codec.hs
@@ -0,0 +1,108 @@
+module Data.CRF.Chain2.Tiers.DAG.Dataset.Codec
+(
+  module Data.CRF.Chain2.Tiers.Dataset.Codec
+
+, Xs
+, XYs
+
+, encodeSent'Cu
+, encodeSent'Cn
+, encodeSent
+
+, encodeData
+, encodeDataL
+, mkCodec
+) where
+
+
+-- import           Prelude hiding (Word)
+import qualified Data.Traversable as T
+import           Data.DAG (DAG)
+
+import           Control.Monad.Codec (evalCodec, execCodec)
+
+import qualified Data.CRF.Chain2.Tiers.Dataset.Internal as I
+import           Data.CRF.Chain2.Tiers.DAG.Dataset.External
+import qualified Data.CRF.Chain2.Tiers.Dataset.Codec as C
+import           Data.CRF.Chain2.Tiers.Dataset.Codec hiding
+  (encodeSent'Cu, encodeSent'Cn, encodeSent, encodeSentL'Cu, encodeSentL'Cn,
+  encodeSentL, encodeData, encodeDataL, mkCodec)
+
+
+-- | Utility types.
+type Xs = DAG () I.X
+-- type Ys = DAG () I.Y
+type XYs = DAG () (I.X, I.Y)
+
+
+-------------------------------------
+-- Normal sentences
+-------------------------------------
+
+
+-- | Encode the sentence and update the codec.
+encodeSent'Cu :: (Ord a, Ord b) => Sent a b -> C.CodecM a b Xs
+encodeSent'Cu = T.mapM C.encodeWord'Cu
+
+
+-- | Encode the sentence and do *not* update the codec.
+encodeSent'Cn :: (Ord a, Ord b) => Sent a b -> C.CodecM a b Xs
+encodeSent'Cn = T.mapM C.encodeWord'Cn
+
+
+-- | Encode the sentence using the given codec.
+encodeSent :: (Ord a, Ord b) => C.Codec a b -> Sent a b -> Xs
+encodeSent codec = evalCodec codec . encodeSent'Cn
+
+
+-------------------------------------
+-- Labeled sentences
+-------------------------------------
+
+
+-- | Encode the labeled sentence and update the codec.
+encodeSentL'Cu :: (Ord a, Ord b) => SentL a b -> C.CodecM a b XYs
+encodeSentL'Cu = T.mapM C.encodeWordL'Cu
+
+
+-- | 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) => SentL a b -> C.CodecM a b XYs
+encodeSentL'Cn = T.mapM C.encodeWordL'Cn
+
+
+-- | 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) => C.Codec a b -> SentL a b -> XYs
+encodeSentL codec = evalCodec codec . encodeSentL'Cn
+
+
+-------------------------------------
+-- Datasets
+-------------------------------------
+
+
+-- | Encode the labeled dataset using the codec.  Substitute the default
+-- label for any label not present in the codec.
+encodeDataL :: (Ord a, Ord b) => C.Codec a b -> [SentL a b] -> [XYs]
+encodeDataL = map . encodeSentL
+
+
+-- | Encode the dataset with the codec.
+encodeData :: (Ord a, Ord b) => C.Codec a b -> [Sent a b] -> [Xs]
+encodeData = map . encodeSent
+
+
+-------------------------------------
+-- Creation
+-------------------------------------
+
+
+-- | Create codec on the basis of the labeled dataset.
+mkCodec
+  :: (Ord a, Ord b)
+  => Int
+  -- ^ The number of layers
+  -> [SentL a b]
+  -> Codec a b
+mkCodec n = execCodec (empty n) . mapM_ encodeSentL'Cu
diff --git a/src/Data/CRF/Chain2/Tiers/DAG/Dataset/External.hs b/src/Data/CRF/Chain2/Tiers/DAG/Dataset/External.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/CRF/Chain2/Tiers/DAG/Dataset/External.hs
@@ -0,0 +1,20 @@
+module Data.CRF.Chain2.Tiers.DAG.Dataset.External
+( Sent
+, SentL
+, module Data.CRF.Chain2.Tiers.Dataset.External
+) where
+
+
+import Prelude hiding (Word)
+import qualified Data.DAG as DAG
+import           Data.DAG (DAG)
+
+import           Data.CRF.Chain2.Tiers.Dataset.External hiding (Sent, SentL)
+
+
+-- | A sentence (DAG) of words.
+type Sent a b = DAG () (Word a b)
+
+
+-- | A sentence (DAG) of labeled words.
+type SentL a b = DAG () (WordL a b)
diff --git a/src/Data/CRF/Chain2/Tiers/DAG/Feature.hs b/src/Data/CRF/Chain2/Tiers/DAG/Feature.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/CRF/Chain2/Tiers/DAG/Feature.hs
@@ -0,0 +1,289 @@
+{-# LANGUAGE RecordWildCards #-}
+
+
+-- | Feature extraction module for DAG-aware CRFs.
+
+
+module Data.CRF.Chain2.Tiers.DAG.Feature
+(
+-- * Feature
+  Feat (..)
+
+-- * Featre extraction
+-- ** Present features
+, presentFeats
+-- ** Hidden features
+, EdgeIx (..)
+, hiddenFeats
+, obFeatsOn
+, trFeatsOn
+
+-- * Feature selection
+, FeatSel
+, selectPresent
+, selectHidden
+
+-- * Indexing
+, lbNum
+, lbIxs
+, edgeIxs
+, prevEdgeIxs
+, nextEdgeIxs
+, initialEdgeIxs
+, finalEdgeIxs
+) where
+
+
+import           Control.Applicative ((<$>))
+
+import qualified Data.Number.LogFloat as L
+import qualified Data.Vector as V
+import           Data.Maybe (maybeToList)
+
+import           Data.DAG (DAG, EdgeID)
+import qualified Data.DAG as DAG
+
+import           Data.CRF.Chain2.Tiers.Core (X, Y, Ob, Cb, CbIx, Feat)
+import qualified Data.CRF.Chain2.Tiers.Core as C
+
+
+----------------------------------------------------
+-- Present features
+----------------------------------------------------
+
+
+-- | Observation features with probabilities for a given edge.
+obFeats :: EdgeID -> DAG a (X, Y) -> [(Feat, L.LogFloat)]
+obFeats edgeID dag =
+  [ (ft, px)
+  | let edgeLabel = DAG.edgeLabel edgeID dag
+  , (x, px) <- C.unY (snd edgeLabel)
+  , o       <- C.unX (fst edgeLabel)
+  , ft      <- C.obFeats o x ]
+
+
+-- | Zero-order transition features with probabilities for a given edge.
+trFeats1 :: EdgeID -> DAG a (X, Y) -> [(Feat, L.LogFloat)]
+trFeats1 i dag =
+  [ (ft, px)
+  | null (prevEdges i) -- TODO: see ticket on Trello
+  , (x, px) <- edgeLabel i
+  , ft <- C.trFeats1 x ]
+  where
+    edgeLabel = C.unY . snd . flip DAG.edgeLabel dag
+    prevEdges = flip DAG.prevEdges dag
+
+
+-- | First-order transition features with probabilities for a given edge.
+trFeats2 :: EdgeID -> DAG a (X, Y) -> [(Feat, L.LogFloat)]
+trFeats2 i dag =
+  [ (ft, px * py)
+  | (x, px) <- edgeLabel i
+  , j <- prevEdges i
+  , null (prevEdges j) -- TODO: see ticket on Trello
+  , (y, py) <- edgeLabel j
+  , ft <- C.trFeats2 x y ]
+  where
+    edgeLabel = C.unY . snd . flip DAG.edgeLabel dag
+    prevEdges = flip DAG.prevEdges dag
+
+
+-- | Second-order transition features with probabilities for a given edge.
+trFeats3 :: EdgeID -> DAG a (X, Y) -> [(Feat, L.LogFloat)]
+trFeats3 i dag =
+  [ (ft, px * py * pz)
+  | (x, px) <- edgeLabel i
+  , j <- prevEdges i
+  , (y, py) <- edgeLabel j
+  , k <- prevEdges j
+  , (z, pz) <- edgeLabel k
+  , ft <- C.trFeats3 x y z ]
+  where
+    edgeLabel = C.unY . snd . flip DAG.edgeLabel dag
+    prevEdges = flip DAG.prevEdges dag
+
+
+-- | Present 'Feat'ures of all kinds occurring w.r.t. to the given edge.
+presentFeatsOn :: EdgeID -> DAG a (X, Y) -> [(Feat, L.LogFloat)]
+presentFeatsOn edgeID dag
+  =  obFeats  edgeID dag
+  ++ trFeats1 edgeID dag
+  ++ trFeats2 edgeID dag
+  ++ trFeats3 edgeID dag
+
+
+-- | Present 'Feat'ures of all kinds occurring in the given DAG.
+presentFeats :: DAG a (X, Y) -> [(Feat, L.LogFloat)]
+presentFeats dag = concat
+  [ presentFeatsOn edgeID dag
+  | edgeID <- DAG.dagEdges dag ]
+
+
+---------------------------------------------
+-- Indexing
+---------------------------------------------
+
+
+-- | List of observations on the given edge of the sentence.
+obList :: DAG a X -> EdgeID -> [Ob]
+obList dag i = C.unX $ DAG.edgeLabel i dag
+{-# INLINE obList #-}
+
+
+-- | Vector of potential labels on the given edge of the sentence.
+lbVec :: DAG a X -> EdgeID -> V.Vector Cb
+lbVec dag i = C._unR $ DAG.edgeLabel i dag
+{-# INLINE lbVec #-}
+
+
+-- | Number of potential labels at the given position of the sentence.
+lbNum :: DAG a X -> EdgeID -> Int
+lbNum dag = V.length . lbVec dag
+{-# INLINE lbNum #-}
+
+
+-- | Potential label at the given position and at the given index.
+lbOn :: DAG a X -> EdgeID -> CbIx -> Maybe Cb
+lbOn dag = (V.!?) . lbVec dag
+{-# INLINE lbOn #-}
+
+
+-- | List of label indices at the given edge.
+lbIxs :: DAG a X -> EdgeID -> [CbIx]
+lbIxs dag i = [0 .. lbNum dag i - 1]
+{-# INLINE lbIxs #-}
+
+
+-- | The list of EdgeIx's corresponding to the given edge.
+edgeIxs :: DAG a X -> EdgeID -> [EdgeIx]
+edgeIxs dag i =
+  [ EdgeIx {edgeID=i, lbIx=u}
+  | u <- lbIxs dag i ]
+
+
+-- | The list of EdgeIx's corresponding to the previous edges.
+-- If the argument edgeID is `Nothing` or if the list of previous
+-- edges is empty, the result will be a singleton list containing
+-- `Nothing` (which represents a special out-of-bounds EdgeIx).
+prevEdgeIxs :: DAG a X -> Maybe EdgeID -> [Maybe EdgeIx]
+prevEdgeIxs _ Nothing = [Nothing]
+prevEdgeIxs dag (Just i)
+  | null js = [Nothing]
+  | otherwise = Just <$>
+    [ EdgeIx {edgeID=j, lbIx=u}
+    | j <- js, u <- lbIxs dag j ]
+  where js = DAG.prevEdges i dag
+
+
+-- | Similar to `prevEdgeIxs` but returns the succeeding edges.
+nextEdgeIxs :: DAG a X -> Maybe EdgeID -> [Maybe EdgeIx]
+nextEdgeIxs _ Nothing = [Nothing]
+nextEdgeIxs dag (Just i)
+  | null js = [Nothing]
+  | otherwise = Just <$>
+    [ EdgeIx {edgeID=j, lbIx=u}
+    | j <- js, u <- lbIxs dag j ]
+  where js = DAG.nextEdges i dag
+
+
+-- | Obtain the list of initial EdgeIxs.
+initialEdgeIxs :: DAG a X -> [EdgeIx]
+initialEdgeIxs dag = concat
+  [ edgeIxs dag i
+  | i <- DAG.dagEdges dag
+  , DAG.isInitialEdge i dag ]
+
+
+-- | Obtain the list of final EdgeIxs.
+finalEdgeIxs :: DAG a X -> [EdgeIx]
+finalEdgeIxs dag = concat
+  [ edgeIxs dag i
+  | i <- DAG.dagEdges dag
+  , DAG.isFinalEdge i dag ]
+
+
+----------------------------------------------------
+-- Hidden features
+----------------------------------------------------
+
+
+-- | Edge with the corresponding label index.
+data EdgeIx = EdgeIx
+  { edgeID :: {-# UNPACK #-} !EdgeID
+    -- ^ ID of an edge
+  , lbIx   :: {-# UNPACK #-} !CbIx
+    -- ^ Index of the corresponding complex label
+  }
+  deriving (Show, Eq, Ord)
+
+
+-- | Observation features on a given position and with respect
+-- to a given label (determined by index).
+obFeatsOn :: DAG a X -> EdgeIx -> [Feat]
+obFeatsOn dag EdgeIx{..} = concat
+  [ C.obFeats o e
+  | e <- maybeToList $ lbOn dag edgeID lbIx
+  , o <- obList dag edgeID ]
+-- obFeatsOn :: DAG a X -> EdgeID -> CbIx -> [Feat]
+-- obFeatsOn dag edgeID lbIx = concat
+--   [ C.obFeats o e
+--   | e <- maybeToList $ lbOn dag edgeID lbIx
+--   , o <- obList dag edgeID ]
+{-# INLINE obFeatsOn #-}
+
+
+-- | Transition features on a given position and with respect
+-- to given labels (determined by indexes).
+trFeatsOn
+  :: DAG a X
+  -> Maybe EdgeIx -- ^ Current EdgeIx
+  -> Maybe EdgeIx -- ^ Previous EdgeIx
+  -> Maybe EdgeIx -- ^ One before the previous EdgeIx
+  -> [Feat]
+trFeatsOn dag u' v' w' = doit
+  (lbOn' =<< u')
+  (lbOn' =<< v')
+  (lbOn' =<< w')
+  where
+    lbOn' EdgeIx{..} = lbOn dag edgeID lbIx
+    doit (Just u) (Just v) (Just w) = C.trFeats3 u v w
+    doit (Just u) (Just v) _        = C.trFeats2 u v
+    doit (Just u) _ _               = C.trFeats1 u
+    doit _ _ _                      = []
+{-# INLINE trFeatsOn #-}
+
+
+-- | Features hidden in the dataset element.
+hiddenFeats :: DAG a X -> [Feat]
+hiddenFeats dag =
+  obFs ++ trFs
+  where
+    obFs = concat
+      [ obFeatsOn dag u
+      | i <- DAG.dagEdges dag
+      , u <- edgeIxs dag i ]
+    trFs = concat
+      [ trFeatsOn dag u v w
+      | i <- DAG.dagEdges dag
+      , u <- Just <$> edgeIxs dag i
+      , v <- prevEdgeIxs dag (edgeID <$> u)
+      , w <- prevEdgeIxs dag (edgeID <$> v) ]
+
+
+----------------------------------------------------
+-- Feature selection
+----------------------------------------------------
+
+
+-- | A feature selection function type.
+type FeatSel a = DAG a (X, Y) -> [Feat]
+
+
+-- | The 'presentFeats' adapted to fit feature selection specs.
+selectPresent :: FeatSel a
+selectPresent = map fst . presentFeats
+
+
+-- | The 'hiddenFeats' adapted to fit feature selection specs.
+selectHidden :: FeatSel a
+selectHidden = hiddenFeats . fmap fst
diff --git a/src/Data/CRF/Chain2/Tiers/DAG/Inference.hs b/src/Data/CRF/Chain2/Tiers/DAG/Inference.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/CRF/Chain2/Tiers/DAG/Inference.hs
@@ -0,0 +1,520 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE Rank2Types #-}
+
+
+module Data.CRF.Chain2.Tiers.DAG.Inference
+( tag
+, tag'
+, tagK
+, marginals
+, marginals'
+, ProbType (..)
+, probs
+, probs'
+, accuracy
+, expectedFeaturesIn
+, zx
+, zx'
+
+-- * Internals (used by `Probs`) (TODO: move elsewhere)
+, AccF
+, ProbArray
+, Pos (..)
+, simplify
+, complicate
+-- ** Memoization
+, memoProbArray
+, memoEdgeIx
+) where
+
+
+import           GHC.Conc (numCapabilities)
+
+import           Control.Applicative ((<$>))
+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.Array as A
+import qualified Data.Set as S
+import           Data.Maybe (fromJust)
+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
+
+import qualified Data.CRF.Chain2.Tiers.Core as C
+import           Data.CRF.Chain2.Tiers.Core (X, Y, Cb, CbIx)
+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
+
+
+---------------------------------------------
+-- Util Types
+---------------------------------------------
+
+
+-- | Accumulation function.
+type AccF = [L.LogFloat] -> L.LogFloat
+
+
+-- | Position in the sentence.
+data Pos
+  = Beg        -- ^ Before the beginning of the sentence
+  | Mid EdgeIx -- ^ Actual edge
+  | End        -- ^ After the end of the sentence
+  deriving (Show, Eq, Ord)
+
+
+-- | Simplify the position by conflating `Beg` and `End` to `Nothing`.
+simplify :: Pos -> Maybe EdgeIx
+simplify (Mid x) = Just x
+simplify Beg = Nothing
+simplify End = Nothing
+
+
+-- | Inverse operation of `simplify`, with the default position value.
+complicate :: Pos -> Maybe EdgeIx -> Pos
+complicate df Nothing = df
+complicate _ (Just x) = Mid x
+
+
+-- | First argument represents the current EdgeIx (Nothing if out of bounds),
+-- the next argument represents the previous EdgeIx.
+type ProbArray = Pos -> Pos -> L.LogFloat
+
+
+---------------------------------------------
+-- Memoization
+---------------------------------------------
+
+
+memoProbArray :: DAG a b -> ProbArray -> ProbArray
+memoProbArray dag =
+  let memo = memoPos dag
+  in  Memo.memo2 memo memo
+
+
+memoPos :: DAG a b -> Memo.Memo Pos
+memoPos dag f =
+  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
+
+
+memoEdgeIx :: DAG a b -> Memo.Memo EdgeIx
+memoEdgeIx dag =
+  Memo.wrap fromPair toPair memoPair
+  where
+    memoPair = Memo.pair memoEdgeID Memo.integral
+    memoEdgeID = Memo.unsafeArrayRange (DAG.minEdge dag, DAG.maxEdge dag)
+    fromPair (x, y) = EdgeIx x y
+    toPair (EdgeIx x y) = (x, y)
+
+
+----------------------------------------------------
+-- Potential
+----------------------------------------------------
+
+
+-- | Observation potential on a given position and a
+-- given label (identified by index).
+onWord :: Md.Model -> DAG a X -> EdgeIx -> L.LogFloat
+onWord crf dag
+  = L.product
+  . map (Md.phi crf)
+  . Ft.obFeatsOn dag
+{-# INLINE onWord #-}
+
+
+-- | Transition potential on a given position and a
+-- given labels (identified by indexes).
+onTransition
+  :: Md.Model
+  -> DAG a X
+  -> Maybe EdgeIx
+  -> Maybe EdgeIx
+  -> Maybe EdgeIx
+  -> L.LogFloat
+onTransition crf dag u w v
+  = L.product
+  . map (Md.phi crf)
+  $ Ft.trFeatsOn dag u w v
+{-# INLINE onTransition #-}
+
+
+---------------------------------------------
+-- A bit more complex stuff
+---------------------------------------------
+
+
+-- | Forward table computation.
+forward :: AccF -> Md.Model -> DAG a X -> ProbArray
+forward acc crf dag =
+  alpha
+  where
+    alpha = memoProbArray dag alpha'
+    alpha' Beg Beg = 1.0
+    alpha' End End = acc
+      [ alpha End (Mid w)
+        -- below, onTransition equals currently to 1; in general, there could be
+        -- some related transition features, though.
+        * onTransition crf dag Nothing Nothing (Just w)
+      | w <- Ft.finalEdgeIxs dag ]
+    alpha' u v = acc
+      [ alpha v w * psi' u
+        * onTransition crf dag (simplify u) (simplify v) (simplify w)
+      | w <- complicate Beg <$> Ft.prevEdgeIxs dag (edgeID <$> simplify v) ]
+    psi' u = case u of
+      Mid x -> psi x
+      _ -> 1.0
+    psi = memoEdgeIx dag $ onWord crf dag
+
+
+-- | Backward table computation.
+backward :: AccF -> Md.Model -> DAG a X -> ProbArray
+backward acc crf dag =
+  beta
+  where
+    beta = memoProbArray dag beta'
+    beta' End End = 1.0
+    beta' Beg Beg = acc
+      [ beta (Mid u) Beg * psi u
+        * onTransition crf dag  (Just u) Nothing Nothing
+      | u <- Ft.initialEdgeIxs dag ]
+    beta' v w = acc
+      [ beta u v * psi' u
+        * onTransition crf dag (simplify u) (simplify v) (simplify w)
+      | u <- complicate End <$> Ft.nextEdgeIxs dag (edgeID <$> simplify v) ]
+    psi' u = case u of
+      Mid x -> psi x
+      _ -> 1.0
+    psi = memoEdgeIx dag $ onWord crf dag
+
+
+-- | Normalization factor computed for the sentence using the forward
+-- computation.
+zx :: Md.Model -> DAG a X -> L.LogFloat
+zx crf = zxAlpha . forward L.sum crf
+
+-- | Normalization factor based on the forward table.
+zxAlpha :: ProbArray -> L.LogFloat
+zxAlpha pa = pa End End
+
+
+-- | Normalization factor computed for the sentence using the backward
+-- computation.
+zx' :: Md.Model -> DAG a X -> L.LogFloat
+zx' crf = zxBeta . backward L.sum crf
+
+-- | Normalization factor based on the backward table.
+zxBeta :: ProbArray -> L.LogFloat
+zxBeta pa = pa Beg Beg
+
+
+-- -- | Probability of chosing the given three edges and the corresponding labels.
+-- edgeProb3
+--   :: Md.Model
+--   -- ^ The underlying model
+--   -> DAG a X
+--   -- ^ The underlying DAG
+--   -> ProbArray
+--   -- ^ Forward probability table
+--   -> ProbArray
+--   -- ^ Backward probability table
+--   -> Int
+--   -- ^ Sentence position
+--   -> (CbIx -> L.LogFloat)
+--   -- ^ Memoized psi (onWord)
+--   -> CbIx
+--   -- ^ Corresponding to the current position `i`
+--   -> CbIx
+--   -- ^ Corresponding to the position `i - 1`
+--   -> CbIx
+--   -- ^ Corresponding to the position `i - 2`
+--   -> L.LogFloat
+-- edgeProb3 crf sent alpha beta 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
+
+
+-- | Probability of chosing the given three edges and the corresponding labels.
+edgeProb3
+  :: Md.Model
+  -- ^ The underlying model
+  -> DAG a X
+  -- ^ The underlying DAG
+  -> (EdgeIx -> L.LogFloat)
+  -- ^ Memoized psi (onWord)
+  -> ProbArray
+  -- ^ Forward probability table
+  -> ProbArray
+  -- ^ Backward probability table
+  -> EdgeIx
+  -- ^ Current edge and the corresponding label
+  -> Maybe EdgeIx
+  -- ^ Previous edge and the corresponding label
+  -> Maybe EdgeIx
+  -- ^ One before the previous edge and the corresponding label
+  -> L.LogFloat
+-- edgeProb3 crf dag psi alpha beta x y z =
+edgeProb3 crf dag psi alpha beta u0 v0 w0
+  = alpha v w
+  * beta u v
+  * psi u0
+  * onTransition crf dag (Just u0) v0 w0
+  / zxBeta beta
+  where
+   u = Mid u0
+   v = complicate Beg v0
+   w = complicate Beg w0
+
+
+-- | Probability of chosing the given pair of edges and the corresponding labels.
+edgeProb2
+  :: ProbArray
+  -- ^ Forward probability table
+  -> ProbArray
+  -- ^ Backward probability table
+  -> EdgeIx
+  -- ^ Current edge and the corresponding label
+  -> Maybe EdgeIx
+  -- ^ Previous edge and the corresponding label
+  -> L.LogFloat
+edgeProb2 alpha beta u0 v0 =
+  alpha u v * beta u v / zxAlpha alpha
+  where
+    u = Mid u0
+    v = complicate Beg v0
+
+
+-- | Probability of chosing the given edge and the corresponding label.
+edgeProb1
+  :: AccF
+  -- ^ Accumulating function (should be the same as the one used to
+  -- compute forward and backward tables)
+  -> DAG a X
+  -- ^ The underlying sentence DAG
+  -> ProbArray
+  -- ^ Forward probability table
+  -> ProbArray
+  -- ^ Backward probability table
+  -> EdgeIx
+  -- ^ Edge and the corresponding label
+  -> L.LogFloat
+edgeProb1 acc dag alpha beta u = acc -- sum
+  [ edgeProb2 alpha beta u v
+  | v <- Ft.prevEdgeIxs dag (Just $ edgeID u) ]
+
+
+-- | Tag potential labels with marginal probabilities.
+marginals :: Md.Model -> DAG a X -> DAG a [(CbIx, L.LogFloat)]
+marginals crf dag =
+  DAG.mapE label dag
+  where
+    label edgeID _ =
+      [ (Ft.lbIx edgeIx, prob1 edgeIx)
+      | edgeIx <- Ft.edgeIxs dag edgeID ]
+    prob1 = edgeProb1 L.sum dag alpha beta
+    alpha = forward L.sum crf dag
+    beta = backward L.sum crf dag
+
+
+-- | Tag potential labels with marginal probabilities.
+marginals' :: Md.Model -> DAG a X -> DAG a [(Cb, L.LogFloat)]
+marginals' crf dag = mergeProbs dag (marginals crf dag)
+
+
+-- -- | Tag potential labels with alternative probabilities.
+-- -- TODO: explain what is that exactly.
+-- probs :: Md.Model -> DAG a X -> DAG a [(CbIx, L.LogFloat)]
+-- probs crf dag =
+--   DAG.mapE label dag
+--   where
+--     label edgeID _ =
+--       [ (Ft.lbIx edgeIx, prob1 edgeIx)
+--       | edgeIx <- Ft.edgeIxs dag edgeID ]
+--     prob1 = edgeProb1 maximum dag alpha beta
+--     alpha = forward maximum crf dag
+--     beta = backward maximum crf dag
+
+
+-- | Type of resulting probabilities.
+data ProbType
+  = Marginals
+  -- ^ Marginal probabilities
+  | MaxProbs
+  -- ^ TODO
+
+
+-- | Tag potential labels with alternative probabilities.
+-- TODO: explain what is that exactly.
+probs :: ProbType -> Md.Model -> DAG a X -> DAG a [(CbIx, L.LogFloat)]
+probs probTyp crf dag =
+  DAG.mapE label dag
+  where
+    label edgeID _ =
+      [ (Ft.lbIx edgeIx, prob1 edgeIx)
+      | edgeIx <- Ft.edgeIxs dag edgeID ]
+    prob1 = edgeProb1 acc dag alpha beta
+    alpha = forward acc crf dag
+    beta = backward acc crf dag
+    acc = case probTyp of
+      Marginals -> L.sum
+      MaxProbs  -> maximum
+
+
+-- | Tag potential labels with alternative probabilities.
+-- TODO: explain what is that exactly.
+probs' :: ProbType -> Md.Model -> DAG a X -> DAG a [(Cb, L.LogFloat)]
+probs' typ crf dag = mergeProbs dag (probs typ crf dag)
+
+
+-- | Utility function useful for `margilans'` and `probs'`.
+mergeProbs :: DAG a X -> DAG a [(CbIx, L.LogFloat)] -> DAG a [(Cb, L.LogFloat)]
+mergeProbs dag
+  = fmap lbAt
+  . DAG.zipE dag
+  where
+    lbAt (x, ys) =
+      [ (C.lbAt x cbIx, pr)
+      | (cbIx, pr) <- ys ]
+
+
+-- | Get (at most) k best tags for each word and return them in
+-- descending order.  TODO: Tagging with respect to marginal
+-- distributions might not be the best idea.  Think of some
+-- more elegant method.
+tagK :: Int -> Md.Model -> DAG a X -> DAG a [(CbIx, L.LogFloat)]
+tagK k crf dag = fmap
+    ( take k
+    . reverse
+    . List.sortBy (compare `on` snd)
+    ) (marginals crf dag)
+
+
+-- | Find the most probable label sequence (with probabilities of individual
+-- lables determined with respect to marginal distributions) satisfying the
+-- constraints imposed over label values.
+tag :: Md.Model -> DAG a X -> DAG a CbIx
+tag crf = fmap (fst . head) . tagK 1 crf
+
+
+-- | Similar to `tag` but directly returns complex labels and not just their
+-- `CbIx` indexes.
+tag' :: Md.Model -> DAG a X -> DAG a Cb
+tag' crf dag
+  = fmap (uncurry C.lbAt)
+  $ DAG.zipE dag (tag crf dag)
+
+
+expectedFeaturesOn
+  :: Md.Model
+  -- ^ CRF model
+  -> DAG a X
+  -- ^ The underlying sentence DAG
+  -> ProbArray
+  -- ^ Forward computation table
+  -> ProbArray
+  -- ^ Backward computation table
+  -> EdgeID
+  -- ^ ID of an edge of the underlying DAG
+  -> [(C.Feat, L.LogFloat)]
+expectedFeaturesOn crf dag alpha beta edgeID =
+  fs1 ++ fs3
+  where
+    psi = memoEdgeIx dag $ onWord crf dag
+    prob1 = edgeProb1 L.sum dag alpha beta
+    prob3 = edgeProb3 crf dag psi alpha beta
+
+    fs1 =
+      [ (ft, prob)
+      | edgeIx <- Ft.edgeIxs dag edgeID
+      , let prob = prob1 edgeIx
+      , ft <- Ft.obFeatsOn dag edgeIx ]
+
+    fs3 =
+      [ (ft, prob)
+      | u <- Just <$> Ft.edgeIxs dag edgeID
+      , v <- Ft.prevEdgeIxs dag (Ft.edgeID <$> u)
+      , w <- Ft.prevEdgeIxs dag (Ft.edgeID <$> v)
+      , let prob = prob3 (fromJust u) v w
+      , ft <- Ft.trFeatsOn dag u v w ]
+
+
+-- | A list of features defined within the context of the sentence accompanied
+-- by expected probabilities determined on the basis of the model.
+--
+-- One feature can occur multiple times in the output list.
+expectedFeaturesIn
+  :: Md.Model
+  -> DAG a X
+  -> [(C.Feat, L.LogFloat)]
+expectedFeaturesIn crf dag = zxF `Par.par` zxB `Par.pseq` zxF `Par.pseq`
+    concat [expectedOn edgeID | edgeID <- DAG.dagEdges dag]
+  where
+    expectedOn = expectedFeaturesOn crf dag alpha beta
+    alpha = forward L.sum crf dag
+    beta = backward L.sum crf dag
+    zxF = zxAlpha alpha
+    zxB = zxBeta beta
+
+
+goodAndBad :: Md.Model -> DAG a (X, Y) -> (Int, Int)
+goodAndBad crf dag =
+
+    F.foldl' gather (0, 0) $ DAG.zipE labels labels'
+
+  where
+
+    gather (good, bad) results =
+      if consistent results
+      then (good + 1, bad)
+      else (good, bad + 1)
+
+    consistent results = case results of
+      (Just xs, Just ys) -> (not . S.null) (S.intersection xs ys)
+      (Nothing, Nothing) -> True
+      _ -> False
+
+    labels' = fmap best $ probs' MaxProbs crf (fmap fst dag)
+    labels  = fmap (best . C.unY)    (fmap snd dag)
+
+    best zs
+      | null zs   = Nothing
+      | otherwise =
+          let maxProb = maximum (map snd zs)
+          in  if maxProb < eps
+              then Nothing
+              else Just
+                   . S.fromList . map fst
+                   . filter ((>= maxProb - eps) . snd)
+                   $ zs
+    eps = 1.0e-9
+
+
+
+goodAndBad' :: Md.Model -> [DAG a (X, Y)] -> (Int, Int)
+goodAndBad' crf dataset =
+    let add (g, b) (g', b') = (g + g', b + b')
+    in  F.foldl' add (0, 0) [goodAndBad crf x | x <- dataset]
+
+
+-- | Compute the accuracy of the model with respect to the labeled dataset.
+accuracy :: Md.Model -> [DAG a (X, Y)] -> Double
+accuracy crf dataset =
+    let k = numCapabilities
+    	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')
+    in  fromIntegral good / fromIntegral (good + bad)
diff --git a/src/Data/CRF/Chain2/Tiers/DAG/Probs.hs b/src/Data/CRF/Chain2/Tiers/DAG/Probs.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/CRF/Chain2/Tiers/DAG/Probs.hs
@@ -0,0 +1,246 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE Rank2Types #-}
+
+
+module Data.CRF.Chain2.Tiers.DAG.Probs
+( probability
+, likelihood
+, parLikelihood
+) where
+
+
+import           GHC.Conc (numCapabilities)
+
+import           Control.Applicative ((<$>))
+import qualified Control.Arrow as Arr
+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           Data.DAG (EdgeID, DAG)
+import qualified Data.DAG as DAG
+
+import qualified Data.CRF.Chain2.Tiers.Core as C
+import           Data.CRF.Chain2.Tiers.Core (X, Y, Ob, Cb, CbIx)
+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           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)
+
+
+--------------------------------------------
+-- Indexing
+---------------------------------------------
+
+
+-- | List of observations on the given edge of the sentence.
+obList :: DAG a (X, Y) -> EdgeID -> [Ob]
+obList dag i = C.unX . fst $ DAG.edgeLabel i dag
+{-# INLINE obList #-}
+
+
+-- | Vector of labels and the corresponding probabilities on the given edge of
+-- the sentence.
+lbVec :: DAG a (X, Y) -> EdgeID -> V.Vector (Cb, Double)
+lbVec dag edgeID =
+  case DAG.edgeLabel edgeID dag of
+    (_, y) -> C._unY y
+{-# INLINE lbVec #-}
+
+
+-- | Number of potential labels on the given edge of the sentence.
+lbNum :: DAG a (X, Y) -> EdgeID -> Int
+lbNum dag = V.length . lbVec dag
+{-# INLINE lbNum #-}
+
+
+-- | Label on the given edge and on the given position.
+lbOn :: DAG a (X, Y) -> EdgeID -> CbIx -> Maybe (Cb, L.LogFloat)
+lbOn dag i = fmap (Arr.second L.logToLogFloat) . (lbVec dag i V.!?)
+{-# INLINE lbOn #-}
+
+
+-- | List of label indices at the given edge.
+lbIxs :: DAG a (X, Y) -> EdgeID -> [CbIx]
+lbIxs dag i = [0 .. lbNum dag i - 1]
+{-# INLINE lbIxs #-}
+
+
+-- | The list of EdgeIx's corresponding to the given edge.
+edgeIxs :: DAG a (X, Y) -> EdgeID -> [EdgeIx]
+edgeIxs dag i =
+  [ EdgeIx {edgeID=i, lbIx=u}
+  | u <- lbIxs dag i ]
+
+
+--------------------------------------------
+-- Indexing advanced
+---------------------------------------------
+
+
+-- | The list of EdgeIx's corresponding to the previous edges. If the argument
+-- edgeID is `Nothing` or if the list of previous edges is empty, the result
+-- will be a singleton list containing `Nothing` (which represents a special
+-- out-of-bounds EdgeIx).
+prevEdgeIxs :: DAG a (X, Y) -> Maybe EdgeID -> [Maybe EdgeIx]
+prevEdgeIxs _ Nothing = [Nothing]
+prevEdgeIxs dag (Just i)
+  | null js = [Nothing]
+  | otherwise = Just <$>
+    [ EdgeIx {edgeID=j, lbIx=u}
+    | j <- js, u <- lbIxs dag j ]
+  where js = DAG.prevEdges i dag
+
+
+-- | Obtain the list of final EdgeIxs.
+finalEdgeIxs :: DAG a (X, Y) -> [EdgeIx]
+finalEdgeIxs dag = concat
+  [ edgeIxs dag i
+  | i <- DAG.dagEdges dag
+  , DAG.isFinalEdge i dag ]
+
+
+---------------------------------------------
+-- Feature alternatives
+---------------------------------------------
+
+
+-- | Observation features on a given position and with respect
+-- to a given label (determined by index).
+obFeatsOn :: DAG a (X, Y) -> EdgeIx -> [C.Feat]
+obFeatsOn dag EdgeIx{..} = concat
+  [ C.obFeats o e
+  | (e, _prob) <- maybeToList $ lbOn dag edgeID lbIx
+  , o <- obList dag edgeID ]
+{-# INLINE obFeatsOn #-}
+
+
+-- | Probability of the given EdgeIx. WARNING: returns 0 if the Ix is not in the
+-- DAG (and we rely on this behavior)!
+probOn :: DAG a (X, Y) -> EdgeIx -> L.LogFloat
+probOn dag EdgeIx{..} =
+  maybe 0 id $ snd <$> lbOn dag edgeID lbIx
+{-# INLINE probOn #-}
+
+
+-- | Transition features on a given position and with respect to given labels
+-- (determined by indexes).
+--
+-- TODO: almost the same as `Feature.trFeatsOn`.
+trFeatsOn
+  :: DAG a (X, Y)
+  -> Maybe EdgeIx -- ^ Current EdgeIx
+  -> Maybe EdgeIx -- ^ Previous EdgeIx
+  -> Maybe EdgeIx -- ^ One before the previous EdgeIx
+  -> [C.Feat]
+trFeatsOn dag u' v' w' = doit
+  (lbOn' =<< u')
+  (lbOn' =<< v')
+  (lbOn' =<< w')
+  where
+    lbOn' EdgeIx{..} = fst <$> lbOn dag edgeID lbIx
+    doit (Just u) (Just v) (Just w) = C.trFeats3 u v w
+    doit (Just u) (Just v) _        = C.trFeats2 u v
+    doit (Just u) _ _               = C.trFeats1 u
+    doit _ _ _                      = []
+{-# INLINE trFeatsOn #-}
+
+
+----------------------------------------------------
+-- Potential
+----------------------------------------------------
+
+
+-- | Observation potential on a given position and a given label (identified by
+-- index), multiplied by the label's probability.
+onWord :: Md.Model -> DAG a (X, Y) -> EdgeIx -> L.LogFloat
+onWord crf dag ix
+  = (probOn dag ix *)
+  . L.product
+  . map (Md.phi crf)
+  . obFeatsOn dag
+  $ ix
+{-# INLINE onWord #-}
+
+
+-- | Transition potential on a given position and a
+-- given labels (identified by indexes).
+onTransition
+  :: Md.Model
+  -> DAG a (X, Y)
+  -> Maybe EdgeIx
+  -> Maybe EdgeIx
+  -> Maybe EdgeIx
+  -> L.LogFloat
+onTransition crf dag u w v
+  = L.product
+  . map (Md.phi crf)
+  $ trFeatsOn dag u w v
+{-# INLINE onTransition #-}
+
+
+---------------------------------------------
+-- A bit more complex stuff
+---------------------------------------------
+
+
+-- | Forward table computation.
+forward :: AccF -> Md.Model -> DAG a (X, Y) -> ProbArray
+forward acc crf dag =
+  alpha
+  where
+    alpha = I.memoProbArray dag alpha'
+    alpha' Beg Beg = 1.0
+    alpha' End End = acc
+      [ alpha End (Mid w)
+        -- below, onTransition equals currently to 1; in general, there could be
+        -- some related transition features, though.
+        * onTransition crf dag Nothing Nothing (Just w)
+      | w <- finalEdgeIxs dag ]
+    alpha' u v = acc
+      [ alpha v w * psi' u
+        * onTransition crf dag (simplify u) (simplify v) (simplify w)
+      | w <- complicate Beg <$> prevEdgeIxs dag (edgeID <$> simplify v) ]
+    psi' u = case u of
+      Mid x -> psi x
+      _ -> 1.0
+    psi = I.memoEdgeIx dag $ onWord crf dag
+
+
+-- | Probability of the given DAG in the given model.
+probability :: Md.Model -> DAG a (X, Y) -> L.LogFloat
+probability crf dag =
+  zxAlpha (forward L.sum crf dag) / normFactor
+  where
+    zxAlpha pa = pa End End
+    normFactor = I.zx crf (fmap fst dag)
+
+
+-- | Log-likelihood of the given dataset (no parallelization).
+likelihood :: Md.Model -> [DAG a (X, Y)] -> L.LogFloat
+likelihood crf = L.product . map (probability crf)
+
+
+-- | Log-likelihood of the given dataset (parallelized version).
+parLikelihood :: Md.Model -> [DAG a (X, Y)] -> L.LogFloat
+parLikelihood crf dataset =
+  let k = numCapabilities
+      parts = partition k dataset
+      probs = Par.parMap Par.rseq (likelihood crf) parts
+  in  L.product probs
diff --git a/src/Data/CRF/Chain2/Tiers/Dataset/Codec.hs b/src/Data/CRF/Chain2/Tiers/Dataset/Codec.hs
--- a/src/Data/CRF/Chain2/Tiers/Dataset/Codec.hs
+++ b/src/Data/CRF/Chain2/Tiers/Dataset/Codec.hs
@@ -1,5 +1,6 @@
 module Data.CRF.Chain2.Tiers.Dataset.Codec
 ( Codec
+, empty
 , CodecM
 , obMax
 , lbMax
@@ -27,6 +28,7 @@
 ) where
 
 
+import Prelude hiding (Word)
 import Control.Applicative ((<$>), (<*>), pure)
 import Control.Comonad.Store (store)
 import Data.Maybe (catMaybes, fromJust)
diff --git a/src/Data/CRF/Chain2/Tiers/Dataset/External.hs b/src/Data/CRF/Chain2/Tiers/Dataset/External.hs
--- a/src/Data/CRF/Chain2/Tiers/Dataset/External.hs
+++ b/src/Data/CRF/Chain2/Tiers/Dataset/External.hs
@@ -10,6 +10,7 @@
 , SentL
 ) where
 
+import Prelude hiding (Word)
 import qualified Data.Set as S
 import qualified Data.Map as M
 
@@ -37,17 +38,29 @@
 newtype Prob a = Prob { unProb :: M.Map a Double }
     deriving (Show, Eq, Ord)
 
+-- -- | Construct the probability distribution.
+-- mkProb :: Ord a => [(a, Double)] -> Prob a
+-- mkProb =
+--     Prob . normalize . M.fromListWith (+) . filter ((>0).snd)
+--   where
+--     normalize dist
+--         | M.null dist =
+--             error "mkProb: no elements with positive probability"
+--         | otherwise   =
+--             let z = sum (M.elems dist)
+--             in  fmap (/z) dist
+
 -- | Construct the probability distribution.
+--
+-- Normalization is not performed because, when working with DAGs, the
+-- probability of a specific DAG edge can be lower than 1 (in particular, it can
+-- be 0).
+--
+-- Elements with probability 0 cab be filtered out since information that a
+-- given label is a potential interpretation of the given word/edge is preserved
+-- at the level of the `Word`
 mkProb :: Ord a => [(a, Double)] -> Prob a
-mkProb =
-    Prob . normalize . M.fromListWith (+) . filter ((>0).snd)
-  where
-    normalize dist 
-        | M.null dist =
-            error "mkProb: no elements with positive probability"
-        | otherwise   =
-            let z = sum (M.elems dist)
-            in  fmap (/z) dist
+mkProb = Prob . M.fromListWith (+) . filter ((>0).snd)
 
 -- | A WordL is a labeled word, i.e. a word with probability distribution
 -- defined over labels.  We assume that every label from the distribution
diff --git a/src/Data/CRF/Chain2/Tiers/Dataset/Internal.hs b/src/Data/CRF/Chain2/Tiers/Dataset/Internal.hs
--- a/src/Data/CRF/Chain2/Tiers/Dataset/Internal.hs
+++ b/src/Data/CRF/Chain2/Tiers/Dataset/Internal.hs
@@ -1,230 +1,49 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-
-
 -- | Internal core data types.
 
 
 module Data.CRF.Chain2.Tiers.Dataset.Internal
 (
--- * Basic types
-  Ob (..)
-, mkOb, unOb
-, Lb (..)
-, mkLb, unLb
-, FeatIx (..)
-, mkFeatIx, unFeatIx
-, CbIx
-
--- * Complex label
-, Cb (..)
-, mkCb
-, unCb
+  module Data.CRF.Chain2.Tiers.Core
 
 -- * Input element (word)
-, X (_unX, _unR)
 , Xs
-, mkX
-, unX
-, unR
 
 -- * Output element (choice)
-, Y (_unY)
 , Ys
-, mkY
-, unY
 
 -- * Indexing
-, lbAt
 , lbOn
 , lbNum
 , lbIxs
 ) where
 
 
-import           Data.Binary (Binary, put, get)
-import           Data.Ix (Ix)
-import           Control.Applicative ((<$>), (<*>))
-import           Control.Arrow (second)
-import           Data.Int (Int16, Int32)
-import qualified Data.Array.Unboxed as A
+-- import           Data.Binary (Binary, put, get)
+-- import           Data.Ix (Ix)
+-- import           Control.Applicative ((<$>), (<*>))
+-- import           Control.Arrow (second)
+-- import           Data.Int (Int16, Int32)
+-- 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.Number.LogFloat as L
--- import qualified Data.Primitive.ByteArray as BA
-
-import           Data.CRF.Chain2.Tiers.Array (Bounds)
-
-----------------------------------------------------------------
--- Basic types
-----------------------------------------------------------------
-
-
--- | An observation.
-newtype Ob = Ob { _unOb :: Int32 }
-    deriving ( Show, Eq, Ord, Binary, A.IArray A.UArray )
---           GeneralizedNewtypeDeriving doesn't work for this in 7.8.2:
---           , G.Vector U.Vector, G.MVector U.MVector, U.Unbox )
-derivingUnbox "Ob" [t| Ob -> Int32 |] [| _unOb |] [| Ob |]
-
--- | Smart observation constructor.
-mkOb :: Int -> Ob
-mkOb = Ob . fromIntegral
-{-# INLINE mkOb #-}
-
-
--- | Deconstract observation.
-unOb :: Ob -> Int
-unOb = fromIntegral . _unOb
-{-# INLINE unOb #-}
-
-
--- | An atomic label.
-newtype Lb = Lb { _unLb :: Int16 }
-    deriving ( Show, Eq, Ord, Binary, A.IArray A.UArray
-             , Num, Ix, Bounds)
-derivingUnbox "Lb" [t| Lb -> Int16 |] [| _unLb |] [| Lb |]
-
-
--- | Smart label constructor.
-mkLb :: Int -> Lb
-mkLb = Lb . fromIntegral
-{-# INLINE mkLb #-}
-
-
--- | Deconstract label.
-unLb :: Lb -> Int
-unLb = fromIntegral . _unLb
-{-# INLINE unLb #-}
-
-
--- | An index of the label.
-type CbIx = Int
-
-
--- | A feature index.  To every model feature a unique index is assigned.
-newtype FeatIx = FeatIx { _unFeatIx :: Int32 }
-    deriving ( Show, Eq, Ord, Binary, A.IArray A.UArray )
-derivingUnbox "FeatIx" [t| FeatIx -> Int32 |] [| _unFeatIx |] [| FeatIx |]
-
--- | Smart feature index constructor.
-mkFeatIx :: Int -> FeatIx
-mkFeatIx = FeatIx . fromIntegral
-{-# INLINE mkFeatIx #-}
-
-
--- | Deconstract feature index.
-unFeatIx :: FeatIx -> Int
-unFeatIx = fromIntegral . _unFeatIx
-{-# INLINE unFeatIx #-}
-
-
-----------------------------------------------------------------
--- Complex label
-----------------------------------------------------------------
-
-
--- TODO: Do we gain anything by representing the
--- complex label with a byte array?  Complex labels
--- should not be directly stored in a model, so if
--- there is something to gain here, its not obvious.
+-- 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.Number.LogFloat as L
+-- -- import qualified Data.Primitive.ByteArray as BA
 --
--- Perhaps a list representation would be sufficient?
-
-
--- -- | A complex label is an array of atomic labels.
--- newtype Cb = Cb { unCb :: BA.ByteArray }
-
-
--- | A complex label is a vector of atomic labels.
-newtype Cb = Cb { _unCb :: U.Vector Lb }
-    deriving (Show, Eq, Ord, Binary)
-
-
--- | Smart complex label constructor.
-mkCb :: [Lb] -> Cb
-mkCb = Cb . U.fromList
-
-
--- | Deconstract complex label.
-unCb :: Cb -> [Lb]
-unCb = U.toList . _unCb
-
-
-----------------------------------------------------------------
--- Internal dataset representation
-----------------------------------------------------------------
-
-
--- | A word is represented by a list of its observations
--- and a list of its potential label interpretations.
-data X = X {
-    -- | A set of observations.
-      _unX :: U.Vector Ob
-    -- | A vector of potential labels.
-    , _unR :: V.Vector Cb }
-    deriving (Show, Eq, Ord)
+-- import           Data.CRF.Chain2.Tiers.Array (Bounds)
 
 
-instance Binary X where
-    put X{..} = put _unX >> put _unR
-    get = X <$> get <*> get
+import           Data.CRF.Chain2.Tiers.Core
 
 
 -- | Sentence of words.
 type Xs = V.Vector X
 
 
--- | Smart `X` constructor.
-mkX :: [Ob] -> [Cb] -> X
-mkX x r = X (U.fromList x) (V.fromList r)
-{-# INLINE mkX #-}
-
-
--- | List of observations.
-unX :: X -> [Ob]
-unX = U.toList . _unX
-{-# INLINE unX #-}
-
-
--- | List of potential labels.
-unR :: X -> [Cb]
-unR = V.toList . _unR
-{-# INLINE unR #-}
-
-
--- | Vector of chosen labels together with
--- corresponding probabilities in log domain.
-newtype Y = Y { _unY :: V.Vector (Cb, Double) }
-    deriving (Show, Eq, Ord, Binary)
-
-
--- | Y constructor.
-mkY :: [(Cb, Double)] -> Y
-mkY = Y . V.fromList . map (second log)
-{-# INLINE mkY #-}
-
-
--- | Y deconstructor symetric to mkY.
-unY :: Y -> [(Cb, L.LogFloat)]
-unY = map (second L.logToLogFloat) . V.toList . _unY
-{-# INLINE unY #-}
-
-
 -- | Sentence of Y (label choices).
 type Ys = V.Vector Y
-
-
--- | Potential label at the given position.
-lbAt :: X -> CbIx -> Cb
-lbAt x = (_unR x V.!)
-{-# INLINE lbAt #-}
 
 
 lbVec :: Xs -> Int -> V.Vector Cb
diff --git a/src/Data/CRF/Chain2/Tiers/Feature.hs b/src/Data/CRF/Chain2/Tiers/Feature.hs
--- a/src/Data/CRF/Chain2/Tiers/Feature.hs
+++ b/src/Data/CRF/Chain2/Tiers/Feature.hs
@@ -3,11 +3,11 @@
 -- * Feature
   Feat (..)
 
--- * Feature generation
-, obFeats
-, trFeats1
-, trFeats2
-, trFeats3
+-- -- * Feature generation
+-- , obFeats
+-- , trFeats1
+-- , trFeats2
+-- , trFeats3
 
 -- * Feature extraction
 , presentFeats
@@ -24,88 +24,11 @@
 
 import           Control.Applicative ((<*>), (<$>))
 import           Data.Maybe (maybeToList)
-import           Data.List (zip4)
-import           Data.Binary (Binary, put, get, putWord8, getWord8)
+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
-
-
-----------------------------------------------------
--- Feature
-----------------------------------------------------
-
-
--- | Feature; every feature is associated to a layer with `ln` identifier.
-data Feat
-    -- | Second-order transition feature.
-    = TFeat3
-        { x1    :: {-# UNPACK #-} !Lb
-        , x2    :: {-# UNPACK #-} !Lb
-        , x3    :: {-# UNPACK #-} !Lb
-        , ln    :: {-# UNPACK #-} !Int }
-    -- | First-order transition feature.
-    | TFeat2
-        { x1    :: {-# UNPACK #-} !Lb
-        , x2    :: {-# UNPACK #-} !Lb
-        , ln    :: {-# UNPACK #-} !Int }
-    -- | Zero-order transition feature.
-    | TFeat1
-        { x1    :: {-# UNPACK #-} !Lb
-        , ln    :: {-# UNPACK #-} !Int }
-    -- | Observation feature.
-    | OFeat
-        { ob    :: {-# UNPACK #-} !Ob
-        , x1    :: {-# UNPACK #-} !Lb
-        , ln    :: {-# UNPACK #-} !Int }
-    deriving (Show, Eq, Ord)
-
-
-instance Binary Feat where
-    put (OFeat o x k)       = putWord8 0 >> put o >> put x >> put k
-    put (TFeat3 x y z k)    = putWord8 1 >> put x >> put y >> put z >> put k
-    put (TFeat2 x y k)      = putWord8 2 >> put x >> put y >> put k
-    put (TFeat1 x k)        = putWord8 3 >> put x >> put k
-    get = getWord8 >>= \i -> case i of
-        0   -> OFeat  <$> get <*> get <*> get
-        1   -> TFeat3 <$> get <*> get <*> get <*> get
-        2   -> TFeat2 <$> get <*> get <*> get
-        3   -> TFeat1 <$> get <*> get
-        _   -> error "get feature: unknown code"
-
-
-----------------------------------------------------
--- Features generation
-----------------------------------------------------
-
-
--- | Generate observation features.
-obFeats :: Ob -> Cb -> [Feat]
-obFeats ob' xs =
-    [ OFeat ob' x k
-    | (x, k) <- zip (unCb xs) [0..] ]
-
-
--- | Generate zero-order transition features.
-trFeats1 :: Cb -> [Feat]
-trFeats1 xs =
-    [ TFeat1 x k
-    | (x, k) <- zip (unCb xs) [0..] ]
-
-
--- | Generate first-order transition features.
-trFeats2 :: Cb -> Cb -> [Feat]
-trFeats2 xs1 xs2 =
-    [ TFeat2 x1' x2' k
-    | (x1', x2', k) <- zip3 (unCb xs1) (unCb xs2) [0..] ]
-
-
--- | Generate second-order transition features.
-trFeats3 :: Cb -> Cb -> Cb -> [Feat]
-trFeats3 xs1 xs2 xs3 =
-    [ TFeat3 x1' x2' x3' k
-    | (x1', x2', x3', k) <- zip4 (unCb xs1) (unCb xs2) (unCb xs3) [0..] ]
+import           Data.CRF.Chain2.Tiers.Dataset.Internal
 
 
 ----------------------------------------------------
@@ -160,13 +83,13 @@
 
 
 -- | Observation features on a given position and with respect
--- to a given label (determined by idenex).
+-- to a given label (determined by index).
 obFeatsOn :: Xs -> Int -> CbIx -> [Feat]
 obFeatsOn xs i u = concat
     [ obFeats ob' e
     | e   <- lbs
     , ob' <- unX (xs V.! i) ]
-  where 
+  where
     lbs     = maybeToList (lbOn xs i u)
 {-# INLINE obFeatsOn #-}
 
diff --git a/src/Data/CRF/Chain2/Tiers/Inference.hs b/src/Data/CRF/Chain2/Tiers/Inference.hs
--- a/src/Data/CRF/Chain2/Tiers/Inference.hs
+++ b/src/Data/CRF/Chain2/Tiers/Inference.hs
@@ -34,6 +34,33 @@
 
 type ProbArray = CbIx -> CbIx -> CbIx -> L.LogFloat
 
+
+----------------------------------------------------
+-- Potential
+----------------------------------------------------
+
+
+-- | Observation potential on a given position and a
+-- given label (identified by index).
+onWord :: Model -> Xs -> Int -> CbIx -> L.LogFloat
+onWord crf xs i u =
+    product . map (phi crf) $ obFeatsOn xs i u
+{-# INLINE onWord #-}
+
+
+-- | Transition potential on a given position and a
+-- given labels (identified by indexes).
+onTransition :: Model -> Xs -> Int -> CbIx -> CbIx -> CbIx -> L.LogFloat
+onTransition crf xs i u w v =
+    product . map (phi crf) $ trFeatsOn xs i u w v
+{-# INLINE onTransition #-}
+
+
+----------------------------------------------------
+-- More complex stuff
+----------------------------------------------------
+
+
 computePsi :: Model -> Xs -> Int -> CbIx -> L.LogFloat
 computePsi crf xs i = (A.!) $ A.array (0, lbNum xs i - 1)
     [ (k, onWord crf xs i k)
@@ -125,6 +152,7 @@
 --         beta = backward maximum crf sent
 --         normalize xs =
 --             let d = - sum xs
+--             -- UPDATE 13/11/2017: maybe it doesn't work because of that?
 --             in map (*d) xs
 --         m1 k x = maximum
 --             [ alpha k x y * beta (k + 1) x y
@@ -164,7 +192,7 @@
 accuracy :: Model -> [(Xs, Ys)] -> Double
 accuracy crf dataset =
     let k = numCapabilities
-    	parts = partition k dataset
+        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')
@@ -201,11 +229,11 @@
     where psi = computePsi crf sent k
           pr1 = prob1 crf alpha beta sent k
           pr3 = prob3 crf alpha beta sent k psi
-          fs1 = [ (ft, pr) 
+          fs1 = [ (ft, pr)
                 | a <- lbIxs sent k
                 , let pr = pr1 a
                 , ft <- obFs a ]
-    	  fs3 = [ (ft, pr) 
+          fs3 = [ (ft, pr)
                 | a <- lbIxs sent k
                 , b <- lbIxs sent $ k - 1
                 , c <- lbIxs sent $ k - 2
diff --git a/src/Data/CRF/Chain2/Tiers/Model.hs b/src/Data/CRF/Chain2/Tiers/Model.hs
--- a/src/Data/CRF/Chain2/Tiers/Model.hs
+++ b/src/Data/CRF/Chain2/Tiers/Model.hs
@@ -17,8 +17,6 @@
 -- * Potential
 , phi
 , index
-, onWord
-, onTransition
 ) where
 
 
@@ -312,19 +310,3 @@
 index :: Model -> Feat -> Maybe FeatIx
 index Model{..} ft = featIndex ft featMap
 {-# INLINE index #-}
-
-
--- | Observation potential on a given position and a
--- given label (identified by index).
-onWord :: Model -> Xs -> Int -> CbIx -> L.LogFloat
-onWord crf xs i u =
-    product . map (phi crf) $ obFeatsOn xs i u
-{-# INLINE onWord #-}
-
-
--- | Transition potential on a given position and a
--- given labels (identified by indexes).
-onTransition :: Model -> Xs -> Int -> CbIx -> CbIx -> CbIx -> L.LogFloat
-onTransition crf xs i u w v =
-    product . map (phi crf) $ trFeatsOn xs i u w v
-{-# INLINE onTransition #-}