diff --git a/NLP/Concraft/Disamb.hs b/NLP/Concraft/Disamb.hs
new file mode 100644
--- /dev/null
+++ b/NLP/Concraft/Disamb.hs
@@ -0,0 +1,198 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module NLP.Concraft.Disamb
+( Tier (..)
+, Tag (..)
+, select
+, splitWord
+, splitSent
+, Ox
+, Schema
+, Ob
+, schema
+, schematize
+, TierConf
+, tear
+, deTear
+, deTears
+, Disamb
+, disamb
+, tagFile
+, learn
+) where
+
+import Control.Applicative ((<$>), (<*>))
+import Data.Maybe (fromJust)
+import Data.List (find)
+import qualified Data.Set as S
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as L
+import qualified Data.Vector as V
+
+import Data.Binary (Binary, get, put)
+import Data.Text.Binary ()
+
+import qualified Control.Monad.Ox as Ox
+import qualified Data.CRF.Chain2.Pair as CRF
+import qualified Numeric.SGD as SGD
+import qualified Data.Tagset.Positional as TP
+
+import NLP.Concraft.Morphosyntax
+import qualified NLP.Concraft.Plain as P
+
+-- | A tier description.
+data Tier = Tier {
+    -- | Does it include the part of speech?
+      withPos   :: Bool
+    -- | Tier grammatical attributes.
+    , withAtts  :: S.Set TP.Attr }
+
+instance Binary Tier where
+    put Tier{..} = put withPos >> put withAtts
+    get = Tier <$> get <*> get
+
+-- | A tag with optional POS.
+data Tag = Tag
+    { pos   :: Maybe TP.POS
+    , atts  :: M.Map TP.Attr T.Text }
+    deriving (Show, Eq, Ord)
+
+instance Binary Tag where
+    put Tag{..} = put pos >> put atts
+    get = Tag <$> get <*> get
+
+-- | Select tier attributes.
+select :: Tier -> TP.Tag -> Tag
+select Tier{..} tag = Tag
+    { pos   = if withPos then Just (TP.pos tag) else Nothing
+    , atts  = M.filterWithKey (\k _ -> k `S.member` withAtts) (TP.atts tag) }
+
+-- | The Ox monad specialized to word token type and text observations.
+-- TODO: Move to monad-ox package from here and from the nerf library.
+type Ox t a = Ox.Ox (Word t) T.Text a
+
+-- | A schema is a block of the Ox computation performed within the
+-- context of the sentence and the absolute sentence position.
+type Schema t a = V.Vector (Word t) -> Int -> Ox t a
+
+-- | An observation consist of an index (of list type) and an actual
+-- observation value.
+type Ob = ([Int], T.Text)
+
+schema :: Schema t ()
+schema sent = \k -> do
+    mapM_ (Ox.save . lowOrth) [k - 1, k, k + 1]
+  where
+    at          = Ox.atWith sent
+    lowOrth i   = T.toLower <$> orth `at` i
+
+-- | Schematize the input sentence according to 'schema' rules.
+schematize :: Sent t -> CRF.Sent Ob t
+schematize sent =
+    [ CRF.mkWord (obs i) (lbs i)
+    | i <- [0 .. n - 1] ]
+  where
+    v = V.fromList sent
+    n = V.length v
+    obs = S.fromList . Ox.execOx . schema v
+    lbs = tags . (v V.!)
+
+type TierConf = (Tier, Tier)
+
+tear :: TierConf -> TP.Tag -> (Tag, Tag)
+tear (t1, t2) = (,) <$> select t1 <*> select t2
+
+-- | Split tags between two layers.
+-- TODO: Add support for multiple layers.
+splitWord :: TierConf -> Word TP.Tag -> Word (Tag, Tag)
+splitWord cfg = mapWord (tear cfg)
+
+splitSent :: TierConf -> Sent TP.Tag -> Sent (Tag, Tag)
+splitSent ts = map (splitWord ts)
+
+-- | The disambiguation model.
+data Disamb = Disamb
+    { crf       :: CRF.CRF Ob Tag Tag
+    , tagset    :: TP.Tagset
+    , tierConf  :: TierConf }
+
+instance Binary Disamb where
+    put Disamb{..} = put crf >> put tagset >> put tierConf
+    get = Disamb <$> get <*> get <*> get
+
+-- | Determine the most probable label sequence.
+disamb :: Disamb -> Sent TP.Tag -> [TP.Tag]
+disamb Disamb{..} sent
+    = deTears tierConf sent
+    . CRF.tag crf
+    . schematize
+    . splitSent tierConf
+    $ sent
+
+deTears :: TierConf -> Sent TP.Tag -> [(Tag, Tag)] -> [TP.Tag]
+deTears cfg sent tiered =
+    [ deTear cfg word pair
+    | (word, pair) <- zip sent tiered ]
+
+-- | Unsplit the list of tag pairs.  TODO: It can be done without the
+-- help of original word.
+deTear :: TierConf -> Word TP.Tag -> (Tag, Tag) -> TP.Tag
+deTear cfg word tiered =
+    fromJust $ find
+        ((==tiered) . tear cfg)
+        (S.toList $ tags word)
+
+-- | Tag the file.
+tagFile
+    :: T.Text           -- ^ Tag indicating unknown words
+    -> Disamb
+    -> FilePath         -- ^ File to tag (plain format)
+    -> IO L.Text
+tagFile ign dmb path =
+    P.showPlain ign . map onSent <$> P.readPlain ign path
+  where
+    onSent sent =
+        [ choose tok y
+        | (tok, y) <- zip sent ys ]
+      where
+        rs = map (fst . P.fromTok) sent
+        xs = map (mapWord parseTag) rs
+        ys = map showTag (disamb dmb xs)
+        choose tok y = P.choose tok (S.singleton y)
+        parseTag = TP.parseTag (tagset dmb)
+        showTag  = TP.showTag (tagset dmb)
+
+-- | TODO: Abstract over the format type.
+learn
+    :: SGD.SgdArgs      -- ^ SGD parameters 
+    -> FilePath         -- ^ File with positional tagset definition
+    -> T.Text        	-- ^ The tag indicating unknown words
+    -> TierConf         -- ^ Tiered tagging configuration
+    -> FilePath         -- ^ Train file (plain format)
+    -> Maybe FilePath   -- ^ Maybe eval file
+    -> IO Disamb
+learn sgdArgs tagsetPath ign tierConf trainPath evalPath'Maybe = do
+    _tagset <- TP.parseTagset tagsetPath <$> readFile tagsetPath
+    _crf <- CRF.train sgdArgs
+        (schemed _tagset ign tierConf trainPath)
+        (schemed _tagset ign tierConf <$> evalPath'Maybe)
+    return $ Disamb _crf _tagset tierConf
+
+-- | Schematized data from the plain file.
+schemed
+    :: TP.Tagset -> T.Text -> TierConf
+    -> FilePath -> IO [CRF.SentL Ob (Tag, Tag)]
+schemed tagset _ign cfg =
+    fmap (map onSent) . P.readPlain _ign
+  where
+    onSent sent =
+        zip (schematize xs') (map mkDist ys')
+      where
+        (xs, ys) = unzip (map P.fromTok sent)
+        xs' = map (mapWord   smash) xs
+        ys' = map (mapChoice smash) ys
+        smash = tear cfg . parseTag
+        parseTag = TP.parseTag tagset
+        mkDist = CRF.mkDist . M.toList . M.map unPositive
diff --git a/NLP/Concraft/Morphosyntax.hs b/NLP/Concraft/Morphosyntax.hs
--- a/NLP/Concraft/Morphosyntax.hs
+++ b/NLP/Concraft/Morphosyntax.hs
@@ -1,7 +1,11 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module NLP.Concraft.Morphosyntax
 ( Word (..)
+, mapWord
 , Sent
 , Choice
+, mapChoice
 , Positive (unPositive)
 , (<+>)
 , mkPositive
@@ -9,6 +13,7 @@
 , known
 ) where
 
+import Control.Arrow (first)
 import Data.Ord (comparing)
 import Data.List (maximumBy)
 import qualified Data.Set as S
@@ -23,6 +28,11 @@
     , tags  :: S.Set t }
     deriving (Show, Read, Eq, Ord)
 
+mapWord :: Ord b => (a -> b) -> Word a -> Word b
+mapWord f Word{..} = Word
+    { orth = orth
+    , tags = S.fromList . map f . S.toList $ tags }
+
 -- | A sentence of 'Word's.
 type Sent t = [Word t]
 
@@ -37,6 +47,9 @@
 (<+>) :: Num a => Positive a -> Positive a -> Positive a
 Positive x <+> Positive y = Positive (x + y)
 {-# INLINE (<+>) #-}
+
+mapChoice :: Ord b => (a -> b) -> Choice a -> Choice b
+mapChoice f = M.fromListWith (<+>) . map (first f) . M.toList
 
 mkPositive :: (Num a, Ord a) => a -> Positive a
 mkPositive x
diff --git a/concraft.cabal b/concraft.cabal
--- a/concraft.cabal
+++ b/concraft.cabal
@@ -1,5 +1,5 @@
 name:               concraft
-version:            0.1.0
+version:            0.2.0
 synopsis:           Morphosyntactic tagging tool based on constrained CRFs
 description:
     A morphosyntactic tagging tool based on constrained conditional
@@ -26,11 +26,14 @@
       , crf-chain1-constrained >= 0.1.1 && < 0.2
       , monad-ox >= 0.2 && < 0.3
       , sgd >= 0.2.2 && < 0.3
+      , tagset-positional >= 0.2 && < 0.3
+      , crf-chain2-generic >= 0.1.1 && < 0.2
 
     exposed-modules:
         NLP.Concraft.Morphosyntax
-      , NLP.Concraft.Guess
       , NLP.Concraft.Plain
+      , NLP.Concraft.Guess
+      , NLP.Concraft.Disamb
 
     ghc-options: -Wall -O2
 
@@ -43,4 +46,11 @@
         cmdargs
     hs-source-dirs: ., tools
     main-is: concraft-guess.hs    
+    ghc-options: -Wall -O2 -threaded
+
+executable concraft-disamb
+    build-depends:
+        cmdargs
+    hs-source-dirs: ., tools
+    main-is: concraft-disamb.hs    
     ghc-options: -Wall -O2 -threaded
diff --git a/tools/concraft-disamb.hs b/tools/concraft-disamb.hs
new file mode 100644
--- /dev/null
+++ b/tools/concraft-disamb.hs
@@ -0,0 +1,86 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+
+import Control.Monad (when)
+import System.Console.CmdArgs
+import Data.Binary (encodeFile, decodeFile)
+import Data.Text.Binary ()
+import qualified Data.Set as S
+import qualified Numeric.SGD as SGD
+import qualified Data.Text as T
+import qualified Data.Text.Lazy.IO as L
+
+import NLP.Concraft.Disamb
+
+tierConf :: TierConf
+tierConf =
+    (tier1, tier2)
+  where
+    tier1 = Tier True $ S.fromList ["cas", "per"]
+    tier2 = Tier False $ S.fromList
+        [ "nmb", "gnd", "deg", "asp" , "ngt", "acm"
+        , "acn", "ppr", "agg", "vlc", "dot" ]
+
+data Args
+  = LearnMode
+    { learnPath	    :: FilePath
+    , evalPath      :: Maybe FilePath
+    , tagsetPath    :: FilePath
+    , ignTag        :: String
+    , iterNum       :: Double
+    , batchSize     :: Int
+    , regVar        :: Double
+    , gain0         :: Double
+    , tau           :: Double
+    , outDisamb     :: FilePath }
+  | TagMode
+    { dataPath      :: FilePath
+    , ignTag        :: String
+    , inDisamb      :: FilePath }
+  deriving (Data, Typeable, Show)
+
+learnMode :: Args
+learnMode = LearnMode
+    { tagsetPath = def &= argPos 0 &= typ "TAGSET-PATH"
+    , ignTag = def &= argPos 1 &= typ "IGN-TAG"
+    , learnPath = def &= argPos 2 &= typ "TRAIN-FILE"
+    , evalPath = def &= typFile &= help "Evaluation file"
+    , iterNum = 10 &= help "Number of SGD iterations"
+    , batchSize = 30 &= help "Batch size"
+    , regVar = 10.0 &= help "Regularization variance"
+    , gain0 = 1.0 &= help "Initial gain parameter"
+    , tau = 5.0 &= help "Initial tau parameter"
+    , outDisamb = def &= typFile &= help "Output Disamb file" }
+
+tagMode :: Args
+tagMode = TagMode
+    { ignTag = def &= argPos 0 &= typ "IGN-TAG"
+    , inDisamb = def &= argPos 1 &= typ "DISAMB-FILE"
+    , dataPath = def &= argPos 2 &= typ "INPUT" }
+
+argModes :: Mode (CmdArgs Args)
+argModes = cmdArgsMode $ modes [learnMode, tagMode]
+
+main :: IO ()
+main = exec =<< cmdArgsRun argModes
+
+exec :: Args -> IO ()
+
+exec LearnMode{..} = do
+    dmb <- learn sgdArgs tagsetPath (T.pack ignTag) tierConf learnPath evalPath
+    when (not . null $ outDisamb) $ do
+        putStrLn $ "\nSaving model in " ++ outDisamb ++ "..."
+        encodeFile outDisamb dmb
+  where
+    sgdArgs = SGD.SgdArgs
+        { SGD.batchSize = batchSize
+        , SGD.regVar = regVar
+        , SGD.iterNum = iterNum
+        , SGD.gain0 = gain0
+        , SGD.tau = tau }
+
+exec TagMode{..} = do
+    dmb <- decodeFile inDisamb
+    L.putStr =<< tagFile (T.pack ignTag) dmb dataPath
