diff --git a/Colada/WordClass.hs b/Colada/WordClass.hs
--- a/Colada/WordClass.hs
+++ b/Colada/WordClass.hs
@@ -31,6 +31,7 @@
        , defaultOptions
          -- * Extracting information
        , summary
+       , summarize
        , wordTypeClasses
          -- * Class and word prediction
        , label
@@ -98,6 +99,7 @@
 import qualified Data.Traversable           as Trav
 import qualified Control.Monad.ST           as ST
 import qualified Control.Monad.ST.Lazy      as LST
+import Data.Function (on)
 import Control.Monad.Writer       
 import Data.Word           (Word32)
 import Data.Typeable       (Typeable)
@@ -261,7 +263,10 @@
 -- | @summary m@ returns a textual summary of word classes found in
 -- model @m@
 summary :: WordClass -> Text.Text
-summary m = 
+summary = summarize False
+
+summarize :: Bool -> WordClass -> Text.Text
+summarize harden m = 
   let format (z,cs) =  do 
         cs' <-  mapM (Atom.fromAtom . fst)
                 . takeWhile ((>0) . snd)
@@ -276,6 +281,14 @@
     . IntMap.toList
     . IntMap.fromListWith (IntMap.unionWith (+))
     . concatMap (\(d,zs) -> [ (z, IntMap.singleton d c) | (z,c) <- zs ])
+    -- Maybe harden    
+    . (if harden 
+       then 
+        map (\(d,zs) -> let s = sum . map snd $ zs 
+                            (z',_) = List.maximumBy (Ord.compare `on` snd) zs
+                        in (d, [ (z, if z == z' then s else 0) | (z,_) <- zs ]))
+      else id)
+    --            
     . IntMap.toList
     . IntMap.map  IntMap.toList
     . LDA.docTopics
diff --git a/colada.cabal b/colada.cabal
--- a/colada.cabal
+++ b/colada.cabal
@@ -1,5 +1,5 @@
 Name:                colada
-Version:             0.4.2
+Version:             0.4.3
 Synopsis:            Colada implements incremental word class class induction 
                      using online LDA
 Description:  Colada implements incremental word class class induction using 
diff --git a/colada.hs b/colada.hs
--- a/colada.hs
+++ b/colada.hs
@@ -32,6 +32,9 @@
                        , _modelPath :: FilePath }
              | Label { _modelPath :: FilePath 
                      , _noContext :: Bool }
+             | Summary { _modelPath :: FilePath 
+                       ,_harden :: Bool }
+
              deriving (Show)
 $(L.mkLabels [''Program])                                       
 
@@ -55,7 +58,16 @@
     
     "NAT" "Number of most probable words to show"
   ]
-  
+
+summary :: Mode Program  
+summary =
+  mode "summary" Summary { _modelPath = "model" , _harden = False } 
+        "Display summary of word classes"
+  (flagArg (\x p -> Right $ maybe p id (M.set modelPath x p)) "FILE")  
+  [ flagNone ["harden"] (\p -> p { _harden = True })
+    "Harden class assignments for summary"
+  ]  
+
 label :: Mode Program
 label =
   mode "label" Label { _modelPath = "model" , _noContext = False } 
@@ -128,7 +140,7 @@
   
 program :: Mode Program                     
 program = modes "colada" Help "Word class learning" 
-          [learn, predict, label, help] 
+          [learn, predict, label, summary, help] 
 
 
 -- Run the program
@@ -163,6 +175,11 @@
         then do Text.putStr . Text.unlines . map formatLabeling $ ls
         else do Text.putStr . C.summary $ m    
       BS.writeFile p . Serialize.encode $ m      
+    Summary { _modelPath = p , _harden = h } -> do  
+      m <- parseModel p
+      if h
+        then do Text.putStr . C.summarize True  $ m   
+        else do Text.putStr . C.summarize False $ m
       
 formatLabeling :: (V.Vector v Int, V.Vector v Text.Text) =>
      v Int -> Text.Text
