diff --git a/Data/CRF/Chain2/Generic/Base.hs b/Data/CRF/Chain2/Generic/Base.hs
deleted file mode 100644
--- a/Data/CRF/Chain2/Generic/Base.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-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)
diff --git a/Data/CRF/Chain2/Generic/Codec.hs b/Data/CRF/Chain2/Generic/Codec.hs
new file mode 100644
--- /dev/null
+++ b/Data/CRF/Chain2/Generic/Codec.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module Data.CRF.Chain2.Generic.Codec
+( CodecM
+, Codec (..)
+
+, 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 Data.Maybe (catMaybes)
+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.Generic.Internal
+import Data.CRF.Chain2.Generic.External
+
+-- | A codec monad.
+type CodecM c a = C.Codec c a
+
+-- | An abstract codec representation with external observation type
+-- 'a', external label type 'b', codec data type 'c', internal
+-- observation type 'o' and internal label type 'e'.
+data Codec a b c o e = Codec {
+    -- | Empty codec.
+      empty     :: c
+    -- | Encode the observation and update the codec
+    -- (only in the encoding direction).
+    , encodeObU :: a -> CodecM c o
+    -- | Encode the observation and do *not* update the codec.
+    , encodeObN :: a -> CodecM c (Maybe o)
+    -- | Encode the label and update the codec.
+    , encodeLbU :: b -> CodecM c e
+    -- | Encode the label and do *not* update the codec.
+    -- In case the label is not a member of the codec,
+    -- return the label code assigned to Nothing label.
+    , encodeLbN :: b -> CodecM c e
+    -- | Decode the label within the codec monad.
+    , decodeLbC :: e -> CodecM c (Maybe b)
+    -- | Is label a member of the codec?
+    , hasLabel  :: c -> b -> Bool }
+
+-- | Encode the labeled word and update the codec.
+encodeWordL'Cu
+    :: (Ord e, Ord o) => Codec a b c o e
+    -> WordL a b -> CodecM c (X o e, Y e)
+encodeWordL'Cu Codec{..} (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 e, Ord o) => Codec a b c o e
+    -> WordL a b -> CodecM c (X o e, Y e)
+encodeWordL'Cn Codec{..} (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 e, Ord o) => Codec a b c o e
+    -> Word a b -> CodecM c (X o e)
+encodeWord'Cu Codec{..} 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 e, Ord o) => Codec a b c o e
+    -> Word a b -> CodecM c (X o e)
+encodeWord'Cn Codec{..} 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 e, Ord o) => Codec a b c o e
+    -> SentL a b -> CodecM c (Xs o e, Ys e)
+encodeSentL'Cu cdc sent = do
+    ps <- mapM (encodeWordL'Cu cdc) 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 e, Ord o) => Codec a b c o e
+    -> SentL a b -> CodecM c (Xs o e, Ys e)
+encodeSentL'Cn cdc sent = do
+    ps <- mapM (encodeWordL'Cn cdc) 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 e, Ord o) => Codec a b c o e
+    -> c -> SentL a b -> (Xs o e, Ys e)
+encodeSentL cdc cdcData = C.evalCodec cdcData . encodeSentL'Cn cdc
+
+-- | Encode the sentence and update the codec.
+encodeSent'Cu
+    :: (Ord e, Ord o) => Codec a b c o e
+    -> Sent a b -> CodecM c (Xs o e)
+encodeSent'Cu cdc = fmap V.fromList . mapM (encodeWord'Cu cdc)
+
+-- | Encode the sentence and do *not* update the codec.
+encodeSent'Cn
+    :: (Ord e, Ord o) => Codec a b c o e
+    -> Sent a b -> CodecM c (Xs o e)
+encodeSent'Cn cdc = fmap V.fromList . mapM (encodeWord'Cn cdc)
+
+-- | Encode the sentence using the given codec.
+encodeSent
+    :: (Ord e, Ord o) => Codec a b c o e
+    -> c -> Sent a b -> Xs o e
+encodeSent cdc cdcData = C.evalCodec cdcData . encodeSent'Cn cdc
+
+-- | Create the codec on the basis of the labeled dataset, return the
+-- resultant codec and the encoded dataset.
+mkCodec
+    :: (Ord e, Ord o) => Codec a b c o e
+    -> [SentL a b] -> (c, [(Xs o e, Ys e)])
+mkCodec cdc
+    = swap
+    . C.runCodec (empty cdc)
+    . mapM (encodeSentL'Cu cdc)
+  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 e, Ord o) => Codec a b c o e
+    -> c -> [SentL a b] -> [(Xs o e, Ys e)]
+encodeDataL cdc cdcData = C.evalCodec cdcData . mapM (encodeSentL'Cn cdc)
+
+-- | Encode the dataset with the codec.
+encodeData
+    :: (Ord e, Ord o) => Codec a b c o e
+    -> c -> [Sent a b] -> [Xs o e]
+encodeData cdc cdcData = map (encodeSent cdc cdcData)
+
+-- | Decode the label.
+decodeLabel :: Codec a b c o e -> c -> e -> Maybe b
+decodeLabel cdc cdcData = C.evalCodec cdcData . decodeLbC cdc
+
+-- | Decode the sequence of labels.
+decodeLabels :: Codec a b c o e -> c -> [e] -> [Maybe b]
+decodeLabels cdc cdcData = C.evalCodec cdcData . mapM (decodeLbC cdc)
+
+-- | Return the label when 'Just' or one of the unknown values
+-- when 'Nothing'.
+unJust :: Codec a b c o e -> c -> Word a b -> Maybe b -> b
+unJust _ _ _ (Just x) = x
+unJust cdc cdcData word Nothing = case allUnk of
+    (x:_)   -> x
+    []      -> error "unJust: Nothing and all values known"
+  where
+    allUnk = filter (not . hasLabel cdc cdcData) (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
diff --git a/Data/CRF/Chain2/Generic/External.hs b/Data/CRF/Chain2/Generic/External.hs
--- a/Data/CRF/Chain2/Generic/External.hs
+++ b/Data/CRF/Chain2/Generic/External.hs
@@ -1,3 +1,5 @@
+-- | External data representation.
+
 module Data.CRF.Chain2.Generic.External
 ( Word (obs, lbs)
 , mkWord
@@ -11,8 +13,7 @@
 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.
+-- | A word consists of a set of observations and a set of potential labels.
 data Word a b = Word {
     -- | Set of observations.
       obs   :: S.Set a
@@ -27,6 +28,7 @@
     | S.null _lbs   = error "mkWord: empty set of potential labels"
     | otherwise     = Word _obs _lbs
 
+-- | A sentence of words.
 type Sent a b = [Word a b]
 
 -- | A probability distribution defined over elements of type a.
diff --git a/Data/CRF/Chain2/Generic/FeatMap.hs b/Data/CRF/Chain2/Generic/FeatMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/CRF/Chain2/Generic/FeatMap.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+
+module Data.CRF.Chain2.Generic.FeatMap
+( FeatMap (..)
+) where
+
+import Data.CRF.Chain2.Generic.Internal
+
+class FeatMap m f where
+    featIndex   :: f -> m f -> Maybe FeatIx
+    mkFeatMap   :: [(f, FeatIx)] -> m f
diff --git a/Data/CRF/Chain2/Generic/FeatMap/Map.hs b/Data/CRF/Chain2/Generic/FeatMap/Map.hs
new file mode 100644
--- /dev/null
+++ b/Data/CRF/Chain2/Generic/FeatMap/Map.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Data.CRF.Chain2.Generic.FeatMap.Map
+( FeatMap (..)
+) where
+
+import Data.Binary (Binary)
+import qualified Data.Map as M
+
+import Data.CRF.Chain2.Generic.Internal
+import qualified Data.CRF.Chain2.Generic.FeatMap as C
+
+newtype FeatMap f = FeatMap { unFeatMap :: M.Map f FeatIx }
+    deriving (Show, Eq, Ord, Binary)
+
+instance Ord f => C.FeatMap FeatMap f where
+    featIndex x (FeatMap m) = M.lookup x m
+    mkFeatMap = FeatMap . M.fromList
diff --git a/Data/CRF/Chain2/Generic/Inference.hs b/Data/CRF/Chain2/Generic/Inference.hs
--- a/Data/CRF/Chain2/Generic/Inference.hs
+++ b/Data/CRF/Chain2/Generic/Inference.hs
@@ -20,7 +20,8 @@
 import Control.Parallel (par, pseq)
 import GHC.Conc (numCapabilities)
 
-import Data.CRF.Chain2.Generic.Base
+import Data.CRF.Chain2.Generic.Internal
+import Data.CRF.Chain2.Generic.FeatMap
 import Data.CRF.Chain2.Generic.Model
 import Data.CRF.Chain2.Generic.Util (partition)
 import qualified Data.CRF.Chain2.Generic.DP as DP
@@ -33,12 +34,14 @@
 
 type ProbArray = LbIx -> LbIx -> LbIx -> L.LogFloat
 
-computePsi :: Ord f => Model o t f -> Xs o t -> Int -> LbIx -> L.LogFloat
+computePsi
+    :: FeatMap m f => Model m 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 :: FeatMap m f => AccF -> Model m 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))
@@ -51,7 +54,7 @@
             * 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 :: FeatMap m f => AccF -> Model m 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))
@@ -74,10 +77,10 @@
     , j <- lbIxs sent (n - 2) ]
     where n = V.length sent
 
-zx :: Ord f => Model o t f -> Xs o t -> L.LogFloat
+zx :: FeatMap m f => Model m 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' :: FeatMap m f => Model m 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)
@@ -86,7 +89,7 @@
               | v1 > v2 = (x1, v1)
               | otherwise = (x2, v2)
 
-tagIxs :: Ord f => Model o t f -> Xs o t -> [Int]
+tagIxs :: FeatMap m f => Model m 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))
@@ -104,12 +107,12 @@
                   | 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 :: FeatMap m f => Model m 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 :: FeatMap m f => Model m o t f -> Xs o t -> [[L.LogFloat]]
 probs crf sent =
     let alpha = forward maximum crf sent
         beta = backward maximum crf sent
@@ -122,7 +125,7 @@
     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 :: FeatMap m f => Model m o t f -> Xs o t -> [[L.LogFloat]]
 marginals crf sent =
     let alpha = forward sum crf sent
         beta = backward sum crf sent
@@ -130,7 +133,9 @@
           | 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
+    :: (Eq t, FeatMap m f) => Model m o t f
+    -> Xs o t -> Ys t -> (Int, Int)
 goodAndBad crf xs ys =
     foldl gather (0, 0) $ zip labels labels'
   where
@@ -144,13 +149,15 @@
         | 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'
+    :: (Eq t, FeatMap m f) => Model m 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 :: (Eq t, FeatMap m f) => Model m o t f -> [(Xs o t, Ys t)] -> Double
 accuracy crf dataset =
     let k = numCapabilities
     	parts = partition k dataset
@@ -160,7 +167,7 @@
     in  fromIntegral good / fromIntegral (good + bad)
 
 prob3
-    :: Ord f => Model o t f -> ProbArray -> ProbArray -> Xs o t
+    :: FeatMap m f => Model m 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 =
@@ -169,21 +176,21 @@
 {-# INLINE prob3 #-}
 
 prob2
-    :: Model o t f -> ProbArray -> ProbArray
+    :: Model m 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
+    :: Model m 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
+    :: FeatMap m f => Model m o t f -> ProbArray -> ProbArray
     -> Xs o t -> Int -> [(f, L.LogFloat)]
 expectedFeaturesOn crf alpha beta sent k =
     fs3 ++ fs1
@@ -203,7 +210,7 @@
           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 :: FeatMap m f => Model m 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
diff --git a/Data/CRF/Chain2/Generic/Internal.hs b/Data/CRF/Chain2/Generic/Internal.hs
--- a/Data/CRF/Chain2/Generic/Internal.hs
+++ b/Data/CRF/Chain2/Generic/Internal.hs
@@ -1,27 +1,174 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- | Internal core data types.
+
 module Data.CRF.Chain2.Generic.Internal
-( lbNum
+(
+-- * Input element (word)
+  X (_unX, _unR)
+, Xs
+, mkX
+, unX
+, unR
+
+-- * Output element (choice)
+, Y (_unY)
+, Ys
+, mkY
+, unY
+
+-- * Indexing
+, lbAt
 , lbOn
+, lbNum
 , lbIxs
+
+-- * Feature index
+
+, FeatIx (..)
+
+-- * Auxiliary
+, LbIx
+, AVec (unAVec)
+, mkAVec
+, AVec2 (unAVec2)
+, mkAVec2
 ) where
 
+import Data.Binary (Binary)
+import qualified Data.Set as S
+import qualified Data.Map as M
+import qualified Data.Array.Unboxed as A
 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 Data.CRF.Chain2.Generic.Base
+-- | An index of the label.
+type LbIx = Int
 
+-- | An ascending vector of distinct elements.
+newtype AVec a = AVec { unAVec :: V.Vector a }
+    deriving (Show, 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 #-}
+
+-- | An ascending vector of distinct elements with respect
+-- to 'fst' values.
+newtype AVec2 a b = AVec2 { unAVec2 :: V.Vector (a, b) }
+    deriving (Show, 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 {
+    -- | A vector of observations.
+      _unX :: AVec o
+    -- | A vector of potential labels.
+    , _unR :: AVec t }
+    deriving (Show, 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 #-}
+
+-- | Vector of chosen labels together with
+-- corresponding probabilities.
+newtype Y t = Y { _unY :: AVec2 t Double }
+    deriving (Show, 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)
+
+-- | Potential label at the given position.
+lbAt :: X o t -> LbIx -> t
+lbAt x = (unAVec (_unR x) V.!)
+{-# INLINE lbAt #-}
+
 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.
+-- | Number of potential labels at the given position of the sentence.
+lbNumI :: Xs o t -> Int -> Int
+lbNumI xs = V.length . unAVec . lbVec xs
+{-# INLINE lbNumI #-}
+
+-- | Potential label at the given position and at the given index.
+lbOnI :: Xs o t -> Int -> LbIx -> t
+lbOnI xs = (V.!) . unAVec . lbVec xs
+{-# INLINE lbOnI #-}
+
+-- | List of label indices at the given position.
+lbIxsI :: Xs o t -> Int -> [LbIx]
+lbIxsI xs i = [0 .. lbNum xs i - 1]
+{-# INLINE lbIxsI #-}
+
+-- | Number of potential labels at the given position of the sentence.
+-- Function extended to indices outside the positions' domain.
 lbNum :: Xs o t -> Int -> Int
-lbNum xs = V.length . unAVec . lbVec xs
+lbNum xs i
+    | i < 0 || i >= n   = 1
+    | otherwise         = lbNumI xs i
+  where
+    n = V.length xs
 {-# INLINE lbNum #-}
 
--- | Potential label on the given vector position.
-lbOn :: Xs o t -> Int -> LbIx -> t
-lbOn xs = (V.!) . unAVec . lbVec xs
+-- | Potential label at the given position and at the given index.
+-- Return Nothing for positions outside the domain.
+lbOn :: Xs o t -> Int -> LbIx -> Maybe t
+lbOn xs i
+    | i < 0 || i >= n   = const Nothing
+    | otherwise         = Just . lbOnI xs i
+  where
+    n = V.length xs
 {-# INLINE lbOn #-}
 
+-- | List of label indices at the given position.  Function extended to
+-- indices outside the positions' domain.
 lbIxs :: Xs o t -> Int -> [LbIx]
-lbIxs xs i = [0 .. lbNum xs i - 1]
+lbIxs xs i
+    | i < 0 || i >= n   = [0]
+    | otherwise         = lbIxsI xs i
+  where
+    n = V.length xs
 {-# INLINE lbIxs #-}
+
+-- | A feature index.  To every model feature a unique index is assigned.
+newtype FeatIx = FeatIx { unFeatIx :: Int }
+    deriving ( Show, Eq, Ord, Binary, A.IArray A.UArray
+             , G.Vector U.Vector, G.MVector U.MVector, U.Unbox )
diff --git a/Data/CRF/Chain2/Generic/Model.hs b/Data/CRF/Chain2/Generic/Model.hs
--- a/Data/CRF/Chain2/Generic/Model.hs
+++ b/Data/CRF/Chain2/Generic/Model.hs
@@ -1,9 +1,11 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 module Data.CRF.Chain2.Generic.Model
-( FeatIx (..)
-, FeatGen (..)
+( FeatGen (..)
+, FeatSel
+, selectPresent
+, selectHidden
 , Model (..)
 , mkModel
 , Core (..)
@@ -27,20 +29,12 @@
 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 )
+import Data.CRF.Chain2.Generic.Internal
+import Data.CRF.Chain2.Generic.FeatMap
 
 -- | Feature generation specification.
 data FeatGen o t f = FeatGen
@@ -50,27 +44,27 @@
     , trFeats3  :: t -> t -> t -> [f] }
 
 -- | A conditional random field.
-data Model o t f = Model
+data Model m o t f = Model
     { values    :: U.Vector Double
-    , ixMap     :: M.Map f FeatIx
+    , ixMap     :: m f
     , 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
+data Core m f = Core
     { valuesC   :: U.Vector Double
-    , ixMapC    :: M.Map f FeatIx }
+    , ixMapC    :: m f }
 
-instance (Ord f, Binary f) => Binary (Core f) where
+instance Binary (m f) => Binary (Core m 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 m o t f -> Core m 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 m f -> FeatGen o t f -> Model m o t f
 withCore Core{..} ftGen = Model valuesC ixMapC ftGen
 
 -- | Features present in the dataset element together with corresponding
@@ -117,30 +111,43 @@
         , 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
+-- | A feature selection function type.
+type FeatSel o t f = FeatGen o t f -> Xs o t -> Ys t -> [f]
+
+-- | The 'presentFeats' adapted to fit feature selection specs.
+selectPresent :: FeatSel o t f
+selectPresent fg xs = map fst . presentFeats fg xs
+
+-- | The 'hiddenFeats' adapted to fit feature selection specs.
+selectHidden :: FeatSel o t f
+selectHidden fg xs _ = hiddenFeats fg xs
+
+mkModel
+    :: (Ord f, FeatMap m f)
+    => FeatGen o t f -> FeatSel o t f
+    -> [(Xs o t, Ys t)] -> Model m o t f
+mkModel fg ftSel 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)
+        in  mkFeatMap (zip featLst featIxs)
     , featGen   = fg }
   where
-    fs = S.fromList $ concatMap (hiddenFeats fg) dataset
+    fs = S.fromList $ concatMap select dataset
+    select = uncurry (ftSel fg)
 
 -- | 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
+phi :: FeatMap m f => Model m o t f -> f -> L.LogFloat
+phi Model{..} ft = case featIndex 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
+index :: FeatMap m f => Model m o t f -> f -> Maybe FeatIx
+index Model{..} ft = featIndex ft ixMap
 {-# INLINE index #-}
 
 obFeatsOn :: FeatGen o t f -> Xs o t -> Int -> LbIx -> [f]
@@ -168,38 +175,14 @@
     doIt _ _ _                      = []
 {-# INLINE trFeatsOn #-}
 
-onWord :: Ord f => Model o t f -> Xs o t -> Int -> LbIx -> L.LogFloat
+onWord :: FeatMap m f => Model m 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
+    :: FeatMap m f => Model m 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 #-}
diff --git a/Data/CRF/Chain2/Generic/Train.hs b/Data/CRF/Chain2/Generic/Train.hs
--- a/Data/CRF/Chain2/Generic/Train.hs
+++ b/Data/CRF/Chain2/Generic/Train.hs
@@ -13,7 +13,8 @@
 import qualified Numeric.SGD as SGD
 import qualified Numeric.SGD.LogSigned as L
 
-import Data.CRF.Chain2.Generic.Base
+import Data.CRF.Chain2.Generic.Internal
+import Data.CRF.Chain2.Generic.FeatMap
 import Data.CRF.Chain2.Generic.External (SentL)
 import Data.CRF.Chain2.Generic.Model
 import Data.CRF.Chain2.Generic.Inference (expectedFeatures, accuracy)
@@ -29,26 +30,29 @@
 -- 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)
+    :: (Ord a, Ord b, Eq t, Ord f, FeatMap m f)
     => SGD.SgdArgs                  -- ^ Args for SGD
     -> CodecSpec a b c o t          -- ^ Codec specification
     -> FeatGen o t f                -- ^ Feature generation
+    -> FeatSel o t f                -- ^ Feature selection
     -> 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 CodecSpec{..} ftGen trainIO evalIO'Maybe = do
+    -> IO (c, Model m o t f)        -- ^ Resulting codec and model
+train sgdArgs CodecSpec{..} ftGen ftSel 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)
+    let crf = mkModel ftGen ftSel 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
+    :: FeatMap m f => Model m 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
@@ -60,7 +64,7 @@
     curr = crf { values = para }
 
 notify
-    :: (Eq t, Ord f) => SGD.SgdArgs -> Model o t f -> [(Xs o t, Ys t)]
+    :: (Eq t, FeatMap m f) => SGD.SgdArgs -> Model m 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 "."
diff --git a/Data/CRF/Chain2/Pair.hs b/Data/CRF/Chain2/Pair.hs
--- a/Data/CRF/Chain2/Pair.hs
+++ b/Data/CRF/Chain2/Pair.hs
@@ -3,6 +3,7 @@
 module Data.CRF.Chain2.Pair
 ( 
 -- * Data types
+-- ** External
   Word (..)
 , mkWord
 , Sent
@@ -10,6 +11,12 @@
 , mkDist
 , WordL
 , SentL
+-- * Internal
+, Ob (..)
+, Lb1 (..)
+, Lb2 (..)
+, Lb
+, Feat (..)
 
 -- * CRF
 , CRF (..)
@@ -17,63 +24,76 @@
 , train
 -- ** Tagging
 , tag
+
+-- * Feature selection
+, FeatSel
+, selectHidden
+, selectPresent
 ) 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.Model
+    (Model, FeatSel, selectHidden, selectPresent, core, withCore)
+import Data.CRF.Chain2.Generic.Codec
 import Data.CRF.Chain2.Generic.External
 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
+import Data.CRF.Chain2.Pair.FeatMap
+import Data.CRF.Chain2.Pair.Codec (codec, CodecData)
 
 data CRF a b c = CRF
-    { codec :: Codec a b c
-    , model :: Model Ob Lb Feat }
+    { codecData :: CodecData a b c
+    , model     :: Model FeatMap 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)
+    put CRF{..} = put codecData >> put (core model)
     get = CRF <$> get <*> do
         _core <- get
         return $ withCore _core featGen
 
-codecSpec :: (Ord a, Ord b, Ord c) => T.CodecSpec a (b, c) (Codec a b c) Ob Lb
+codecSpec
+    :: (Ord a, Ord b, Ord c)
+    => T.CodecSpec a (b, c) (CodecData a b c) Ob Lb
 codecSpec = T.CodecSpec
-    { T.mkCodec = mkCodec
-    , T.encode  = encodeDataL }
+    { T.mkCodec = mkCodec codec
+    , T.encode  = encodeDataL codec }
 
 -- | 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.
+-- Use the provided feature selection function to determine model
+-- features.
 train
     :: (Ord a, Ord b, Ord c)
     => SGD.SgdArgs                  -- ^ Args for SGD
+    -> FeatSel Ob Lb Feat           -- ^ Feature selection
     -> 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
+train sgdArgs featSel trainIO evalIO'Maybe = do
+    (_codecData, _model) <- T.train
         sgdArgs
         codecSpec
         featGen
+        featSel
         trainIO
         evalIO'Maybe
-    return $ CRF _codec _model
+    return $ CRF _codecData _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
+    = onWords . decodeLabels codec codecData
+    . I.tag model . encodeSent codec codecData
     $ sent
   where
     onWords xs =
-        [ unJust codec word x
+        [ unJust codec codecData word x
         | (word, x) <- zip sent xs ]
diff --git a/Data/CRF/Chain2/Pair/Base.hs b/Data/CRF/Chain2/Pair/Base.hs
--- a/Data/CRF/Chain2/Pair/Base.hs
+++ b/Data/CRF/Chain2/Pair/Base.hs
@@ -10,24 +10,25 @@
 ) where
 
 import Control.Applicative ((<$>), (<*>)) 
+import Data.Ix (Ix)
 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)
+newtype Ob  = Ob  { unOb  :: Int } deriving (Show, Eq, Ord, Ix, Binary)
+newtype Lb1 = Lb1 { unLb1 :: Int } deriving (Show, Eq, Ord, Ix, Binary)
+newtype Lb2 = Lb2 { unLb2 :: Int } deriving (Show, Eq, Ord, Ix, 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'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
+    | OFeat'1   {-# UNPACK #-} !Ob  {-# UNPACK #-} !Lb1
+    | OFeat'2   {-# UNPACK #-} !Ob  {-# UNPACK #-} !Lb2
     deriving (Show, Eq, Ord)
 
 instance Binary Feat where
diff --git a/Data/CRF/Chain2/Pair/Codec.hs b/Data/CRF/Chain2/Pair/Codec.hs
--- a/Data/CRF/Chain2/Pair/Codec.hs
+++ b/Data/CRF/Chain2/Pair/Codec.hs
@@ -1,48 +1,25 @@
 module Data.CRF.Chain2.Pair.Codec
-( Codec
-, CodecM
+( CodecData
 , 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
+, codec
 ) where
 
-import Control.Applicative (pure, (<$>), (<*>))
+import Control.Applicative ((<$>), (<*>))
 import Control.Comonad.Trans.Store (store)
-import Data.Maybe (fromJust, catMaybes)
+import Data.Maybe (fromJust)
 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.Generic.Codec (Codec(..))
 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 =
+type CodecData a b c =
     ( C.AtomCodec a
     , C.AtomCodec (Maybe b)
     , C.AtomCodec (Maybe c) )
@@ -69,225 +46,47 @@
 _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 :: CodecData 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 :: CodecData 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 :: CodecData 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
+codec :: (Ord a, Ord b, Ord c) => Codec a (b, c) (CodecData a b c) Ob Lb
+codec = Codec
+    { empty = 
+        ( C.empty
+        , C.execCodec C.empty (C.encode C.idLens Nothing)
+        , C.execCodec C.empty (C.encode C.idLens Nothing) )
+    , encodeObU = fmap Ob . C.encode' _1Lens
+    , encodeObN = fmap (fmap Ob) . C.maybeEncode _1Lens
+    , encodeLbU = \ (x, y) -> do
+        x' <- C.encode _2Lens (Just x)
+        y' <- C.encode _3Lens (Just y)
+        return (Lb1 x', Lb2 y')
+    , 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')
+    , decodeLbC = \ (x, y) -> do
+        x' <- C.decode _2Lens (unLb1 x)
+        y' <- C.decode _3Lens (unLb2 y)
+        return $ (,) <$> x' <*> y'
+    , hasLabel = \ cdcData (x, y)
+        -> M.member (Just x) (C.to $ _2 cdcData)
+        && M.member (Just y) (C.to $ _3 cdcData) }
diff --git a/Data/CRF/Chain2/Pair/FeatMap.hs b/Data/CRF/Chain2/Pair/FeatMap.hs
new file mode 100644
--- /dev/null
+++ b/Data/CRF/Chain2/Pair/FeatMap.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Data.CRF.Chain2.Pair.FeatMap
+( FeatMap (..)
+) where
+
+import Control.Applicative ((<$>), (<*>))
+import Control.Monad (guard)
+import Data.List (foldl1')
+import Data.Maybe (catMaybes)
+import Data.Ix (Ix, inRange, range)
+import Data.Binary (Binary, put, get)
+import qualified Data.Array.Unboxed as A
+import qualified Data.Map as M
+
+import Data.CRF.Chain2.Pair.Base
+import Data.CRF.Chain2.Generic.Internal (FeatIx(..))
+import qualified Data.CRF.Chain2.Generic.FeatMap as C
+
+-- | Dummy feature index.
+dummy :: FeatIx
+dummy = FeatIx (-1)
+{-# INLINE dummy #-}
+
+data FeatMap a = FeatMap
+    { trMap3'1  :: A.UArray (Lb1, Lb1, Lb1) FeatIx
+    , trMap3'2  :: A.UArray (Lb2, Lb2, Lb2) FeatIx
+    , otherMap  :: M.Map Feat FeatIx }
+
+(!?) :: (Ix i, A.IArray a b) => a i b -> i -> Maybe b
+m !? x = if inRange (A.bounds m) x
+    then Just (m A.! x)
+    else Nothing
+{-# INLINE (!?) #-}
+
+instance C.FeatMap FeatMap Feat where
+    featIndex (TFeat3'1 x y z) (FeatMap m _ _)  = do
+        ix <- m !? (x, y, z)
+        guard (ix /= dummy)
+        return ix
+    featIndex (TFeat3'2 x y z) (FeatMap _ m _)  = do
+        ix <- m !? (x, y, z)
+        guard (ix /= dummy)
+        return ix
+    featIndex x (FeatMap _ _ m)                 = M.lookup x m
+    mkFeatMap xs = FeatMap
+        (mkArray (catMaybes $ map getTFeat3'1 xs))
+        (mkArray (catMaybes $ map getTFeat3'2 xs))
+        (M.fromList (filter (isOther . fst) xs))
+      where
+        getTFeat3'1 (TFeat3'1 x y z, v) = Just ((x, y, z), v)
+        getTFeat3'1 _                   = Nothing
+        getTFeat3'2 (TFeat3'2 x y z, v) = Just ((x, y, z), v)
+        getTFeat3'2 _                   = Nothing
+        isOther (TFeat3'1 _ _ _)        = False
+        isOther (TFeat3'2 _ _ _)        = False
+        isOther _                       = True
+        mkArray ys =
+            let p = foldl1' updateMin (map fst ys)
+                q = foldl1' updateMax (map fst ys)
+                updateMin (x, y, z) (x', y', z') =
+                    (min x x', min y y', min z z')
+                updateMax (x, y, z) (x', y', z') =
+                    (max x x', max y y', max z z')
+                zeroed pq = A.array pq [(k, dummy) | k <- range pq]
+            in  zeroed (p, q) A.// ys
+
+instance Binary (FeatMap Feat) where
+    put FeatMap{..} = put trMap3'1 >> put trMap3'2 >> put otherMap
+    get = FeatMap <$> get <*> get <*> get
diff --git a/crf-chain2-generic.cabal b/crf-chain2-generic.cabal
--- a/crf-chain2-generic.cabal
+++ b/crf-chain2-generic.cabal
@@ -1,12 +1,13 @@
 name:               crf-chain2-generic
-version:            0.1.1
+version:            0.3.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
+    imposed over label values.  It also provides a generic framework for
     defining custom feature data types and feature generation
-    functions.
+    functions (see "Data.CRF.Chain2.Generic") together with
+    some concrete model examples (e.g. "Data.CRF.Chain2.Pair").
 license:            BSD3
 license-file:       LICENSE
 cabal-version:      >= 1.6
@@ -34,18 +35,21 @@
       , sgd >= 0.2.2 && < 0.3
 
     exposed-modules:
-        Data.CRF.Chain2.Generic.Base
+        Data.CRF.Chain2.Generic.Internal
+      , Data.CRF.Chain2.Generic.FeatMap
+      , Data.CRF.Chain2.Generic.FeatMap.Map
       , Data.CRF.Chain2.Generic.External
       , Data.CRF.Chain2.Generic.Model
       , Data.CRF.Chain2.Generic.Inference
       , Data.CRF.Chain2.Generic.Train
+      , Data.CRF.Chain2.Generic.Codec
       , Data.CRF.Chain2.Pair.Base
+      , Data.CRF.Chain2.Pair.FeatMap
       , 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.DP
       , Data.CRF.Chain2.Generic.Util
         
     ghc-options: -Wall -O2