diff --git a/concraft.cabal b/concraft.cabal
--- a/concraft.cabal
+++ b/concraft.cabal
@@ -1,5 +1,5 @@
 name:               concraft
-version:            0.8.3
+version:            0.9.0
 synopsis:           Morphological disambiguation based on constrained CRFs
 description:
     A morphological disambiguation library based on
@@ -36,7 +36,7 @@
       , sgd                     >= 0.3.3    && < 0.4
       , tagset-positional       >= 0.3      && < 0.4
       , crf-chain1-constrained  >= 0.3      && < 0.4
-      , crf-chain2-tiers        >= 0.2      && < 0.3
+      , crf-chain2-tiers        >= 0.2.1    && < 0.3
       , monad-codec             >= 0.2      && < 0.3
       , data-lens               >= 2.10     && < 2.11
       , transformers            >= 0.2      && < 0.4
diff --git a/src/NLP/Concraft.hs b/src/NLP/Concraft.hs
--- a/src/NLP/Concraft.hs
+++ b/src/NLP/Concraft.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
 
+
 module NLP.Concraft
 (
 -- * Model 
@@ -9,15 +10,21 @@
 
 -- * Tagging
 , tag
+, marginals
 
 -- * Training
 , train
 , reAnaTrain
+
+-- * Pruning
+, prune
 ) where
 
+
 import           System.IO (hClose)
 import           Control.Applicative ((<$>), (<*>))
 import           Control.Monad (when)
+import qualified Data.Set as S
 import           Data.Binary (Binary, put, get)
 import qualified Data.Binary as Binary
 import           Data.Aeson
@@ -84,12 +91,30 @@
 
 -- | Tag sentence using the model.  In your code you should probably
 -- use your analysis function, translate results into a container of
--- `Sent`ences, evaluate `tagSent` on each sentence and embed the
--- tagging results into morphosyntactic structure of your own.
-tag :: Word w => Concraft -> Sent w P.Tag -> [P.Tag]
-tag Concraft{..} = D.disamb disamb . G.guessSent guessNum guesser
+-- `Sent`ences, evaluate `tag` on each sentence and embed the
+-- tagging results into the morphosyntactic structure of your own.
+--
+-- The function returns guessing results as `fst` elements
+-- of the output pairs and disambiguation results as `snd`
+-- elements of the corresponding pairs.
+tag :: Word w => Concraft -> Sent w P.Tag -> [(S.Set P.Tag, P.Tag)]
+tag Concraft{..} sent =
+    zip (map S.fromList gss) tgs
+  where
+    gss = G.guess guessNum guesser sent
+    tgs = D.disamb disamb (G.include gss sent)
 
 
+-- | Determine marginal probabilities corresponding to individual
+-- tags w.r.t. the disambiguation model.  Since the guessing model
+-- is used first, the resulting weighted maps may contain tags
+-- not present in the input sentence.
+marginals :: Word w => Concraft -> Sent w P.Tag -> [WMap P.Tag]
+marginals Concraft{..} sent =
+    let gss = G.guess guessNum guesser sent
+    in  D.marginals disamb (G.include gss sent)
+
+
 ---------------------
 -- Training
 ---------------------
@@ -102,7 +127,7 @@
     -> Analyse w P.Tag      -- ^ Analysis function
     -> Int                  -- ^ Numer of guessed tags for each word 
     -> G.TrainConf          -- ^ Guessing model training configuration
-    -> D.TrainConf          -- ^ Disambiguation model training configuration
+    -> D.TrainConf          -- ^ Disamb model training configuration
     -> IO [SentO w P.Tag]   -- ^ Training data
     -> IO [SentO w P.Tag]   -- ^ Evaluation data
     -> IO Concraft
@@ -126,7 +151,7 @@
     => P.Tagset             -- ^ Tagset
     -> Int                  -- ^ Numer of guessed tags for each word
     -> G.TrainConf          -- ^ Guessing model training configuration
-    -> D.TrainConf          -- ^ Disambiguation model training configuration
+    -> D.TrainConf          -- ^ Disamb model training configuration
     -> IO [Sent w P.Tag]    -- ^ Training data
     -> IO [Sent w P.Tag]    -- ^ Evaluation data
     -> IO Concraft
@@ -145,6 +170,18 @@
     disamb <- D.train disambConf trainG'IO evalG'IO
     return $ Concraft tagset guessNum guesser disamb
 
+
+---------------------
+-- Pruning
+---------------------
+
+
+-- | Prune disambiguation model: discard model features with
+-- absolute values (in log-domain) lower than the given threshold.
+prune :: Double -> Concraft -> Concraft
+prune x concraft =
+    let disamb' = D.prune x (disamb concraft)
+    in  concraft { disamb = disamb' }
 
 
 ---------------------
diff --git a/src/NLP/Concraft/Disamb.hs b/src/NLP/Concraft/Disamb.hs
--- a/src/NLP/Concraft/Disamb.hs
+++ b/src/NLP/Concraft/Disamb.hs
@@ -11,6 +11,7 @@
 , P.Atom (..)
 
 -- * Disambiguation
+, marginals
 , disamb
 , include
 , disambSent
@@ -18,11 +19,13 @@
 -- * Training
 , TrainConf (..)
 , train
+
+-- * Pruning
+, prune
 ) where
 
 
 import Control.Applicative ((<$>), (<*>))
-import Data.Maybe (fromJust)
 import Data.List (find)
 import Data.Binary (Binary, put, get)
 import qualified Data.Set as S
@@ -68,7 +71,11 @@
 -- | Unsplit the complex tag (assuming, that it is one
 -- of the interpretations of the word).
 unSplit :: Eq t => (r -> t) -> X.Seg w r -> t -> r
-unSplit split' word x = fromJust $ find ((==x) . split') (X.interps word)
+unSplit split' word x = case jy of
+    Just y  -> y
+    Nothing -> error "unSplit: no such interpretation"
+  where
+    jy = find ((==x) . split') (X.interps word)
 
 
 -- | Perform context-sensitive disambiguation.
@@ -103,13 +110,40 @@
 disambSent = include . disamb
 
 
+-- | Tag labels with marginal probabilities.
+marginals :: X.Word w => Disamb -> X.Sent w T.Tag -> [X.WMap T.Tag]
+marginals Disamb{..} sent
+    = map (uncurry embed)
+    . zip sent
+    . CRF.marginals crf
+    . schematize schema
+    . X.mapSent split
+    $ sent
+  where
+    schema  = fromConf schemaConf
+    split   = P.split tiers
+    embed w = X.mkWMap . zip (X.interps w)
+
+
+-- | Prune disamb model: discard model features with absolute values
+-- (in log-domain) lower than the given threshold.
+prune :: Double -> Disamb -> Disamb
+prune x dmb =
+    let crf' = CRF.prune x (crf dmb)
+    in  dmb { crf = crf' }
+
+
 -- | Training configuration.
-data TrainConf = TrainConf
-    { tiersT        :: [P.Tier]
-    , schemaConfT   :: SchemaConf
-    , sgdArgsT      :: SGD.SgdArgs
-    , onDiskT       :: Bool
-    , pruneT        :: Maybe Double }
+data TrainConf
+    = TrainConf
+        { tiersT        :: [P.Tier]
+        , schemaConfT   :: SchemaConf
+        , sgdArgsT      :: SGD.SgdArgs
+        , onDiskT       :: Bool }
+    | ReTrainConf
+        { initDmb       :: Disamb
+        , sgdArgsT      :: SGD.SgdArgs
+        , onDiskT       :: Bool }
 
 
 -- | Train disamb model.
@@ -120,37 +154,26 @@
     -> IO [X.Sent w T.Tag]      -- ^ Evaluation data
     -> IO Disamb                -- ^ Resultant model
 train TrainConf{..} trainData evalData = do
-
-    -- Train first model
     crf <- CRF.train (length tiersT) CRF.selectHidden sgdArgsT onDiskT
         (schemed schema split <$> trainData)
         (schemed schema split <$> evalData)
     putStr "\nNumber of features: " >> print (CRF.size crf)
-
-    -- Re-train model if prune parameter is Just
-    reCrf <- case pruneT of
-        Just th -> do 
-            putStrLn "\n===== Prune and retrain disambiguation model ====="
-            crf' <- CRF.reTrain (CRF.prune th crf)
-                (gainMul 0.5 sgdArgsT) onDiskT
-                (schemed schema split <$> trainData)
-                (schemed schema split <$> evalData)
-            putStr "\nNumber of features: " >> print (CRF.size crf')
-            return crf'
-        Nothing -> return crf
-
-    -- Final disamb model
-    return $ Disamb tiersT schemaConfT reCrf
-
+    return $ Disamb tiersT schemaConfT crf
   where
-
     schema = fromConf schemaConfT
     split  = P.split tiersT
 
-    -- Muliply gain0 parameter by the given number.
-    gainMul x sgdArgs =
-        let gain0' = SGD.gain0 sgdArgs * x
-        in  sgdArgs { SGD.gain0 = gain0' }
+-- Improve disamb model.
+train ReTrainConf{..} trainData evalData = do
+    crf' <- CRF.reTrain crf sgdArgsT onDiskT
+        (schemed schema split <$> trainData)
+        (schemed schema split <$> evalData)
+    putStr "\nNumber of features: " >> print (CRF.size crf')
+    return $ initDmb { crf = crf' }
+  where
+    Disamb{..} = initDmb
+    schema = fromConf schemaConf
+    split  = P.split tiers
 
 
 -- | Schematized data from the plain file.
diff --git a/src/NLP/Concraft/Guess.hs b/src/NLP/Concraft/Guess.hs
--- a/src/NLP/Concraft/Guess.hs
+++ b/src/NLP/Concraft/Guess.hs
@@ -62,7 +62,9 @@
         where w = v V.! i
 
 
--- | Determine 'k' most probable labels for each word in the sentence.
+-- | Determine the 'k' most probable labels for each word in the sentence.
+-- TODO: Perhaps it would be better to use sets instead of lists
+-- as output?
 guess :: (X.Word w, Ord t)
       => Int -> Guesser t -> X.Sent w t -> [[t]]
 guess k gsr sent =
@@ -71,9 +73,8 @@
 
 
 -- | Insert guessing results into the sentence.
-include :: (X.Word w, Ord t) => (X.Sent w t -> [[t]])
-        -> X.Sent w t -> X.Sent w t
-include f sent =
+include :: (X.Word w, Ord t) => [[t]] -> X.Sent w t -> X.Sent w t
+include xss sent =
     [ word { X.tags = tags }
     | (word, tags) <- zip sent sentTags ]
   where
@@ -81,7 +82,7 @@
         [ if X.oov word
             then addInterps (X.tags word) xs
             else X.tags word
-        | (xs, word) <- zip (f sent) sent ]
+        | (xs, word) <- zip xss sent ]
     addInterps wm xs = X.mkWMap
         $  M.toList (X.unWMap wm)
         ++ zip xs [0, 0 ..]
@@ -90,7 +91,8 @@
 -- | Combine `guess` with `include`. 
 guessSent :: (X.Word w, Ord t)
           => Int -> Guesser t -> X.Sent w t -> X.Sent w t
-guessSent guessNum guesser = include (guess guessNum guesser)
+guessSent guessNum guesser sent =
+    include (guess guessNum guesser sent) sent
 
 
 -- | Method of constructing the default set of labels (R0).
diff --git a/src/NLP/Concraft/Morphosyntax.hs b/src/NLP/Concraft/Morphosyntax.hs
--- a/src/NLP/Concraft/Morphosyntax.hs
+++ b/src/NLP/Concraft/Morphosyntax.hs
@@ -34,6 +34,7 @@
 import           Control.Applicative ((<$>), (<*>))
 import           Control.Arrow (first)
 import           Data.Aeson
+import           Data.Binary (Binary)
 import qualified Data.Set as S
 import qualified Data.Map as M
 import qualified Data.Text as T
@@ -134,7 +135,7 @@
 -- | A set with a non-negative weight assigned to each of
 -- its elements.
 newtype WMap a = WMap { unWMap :: M.Map a Double }
-    deriving (Show, Eq, Ord)
+    deriving (Show, Eq, Ord, Binary)
 
 
 -- | Make a weighted collection.  Negative elements will be ignored.