packages feed

colada 0.8.0.0 → 0.8.3.0

raw patch · 3 files changed

+88/−40 lines, 3 filesdep +nlp-scores

Dependencies added: nlp-scores

Files

Colada/WordClass.hs view
@@ -46,12 +46,14 @@          -- | Feature string to atom and vice versa conversion tables        , options          -- | Options for Gibbs sampling+       , SummaryType(..)        , LDA.Finalized        , LDA.docTopics        , LDA.wordTopics        , LDA.topics        , LDA.topicDocs        , LDA.topicWords+         -- | Counts of words in LDA model        , Options        , featIds          -- | Feature ids@@ -111,9 +113,8 @@ import GHC.Generics (Generic) import qualified Data.Label as L import Data.Label (get)-+import qualified NLP.Scores   as Scores import qualified NLP.SwiftLDA as LDA- -- Package modules import qualified Colada.Features as F import qualified NLP.Symbols     as Symbols@@ -228,40 +229,59 @@           --return (da, U.fromList $ zip was (repeat Nothing))           return (da, U.fromList was) ++data SummaryType =  +             Soft    -- Most frequent word per class according to soft assignments.+           | Hard    -- Assign each word to predominant class, output most frequent per class.+           | LLR     -- Ranked by -2 * log-likelihood-ratio +           deriving (Show) -- | @summary m@ returns a textual summary of word classes found in -- model @m@ summary :: WordClass -> Text.Text-summary = summarize False+summary = summarize Soft -summarize :: Bool -> WordClass -> Text.Text-summarize harden m = -  let format (z,cs) =  do +summarize :: SummaryType -> WordClass -> Text.Text+summarize typ m = ++  let inv t = IntMap.toList . IntMap.fromListWith IntMap.union +                               $ [ (k2, IntMap.singleton k1  c) | (k1, v1) <- t, (k2, c) <- v1 ]+      format (z,cs) =  do          cs' <-  mapM (Atom.fromAtom . fst)-                . takeWhile ((>0) . snd)                 . take 10                  . List.sortBy (flip $ Ord.comparing snd) . IntMap.toList                  $ cs         return . Text.unwords $ Text.pack (show z) -          : map (Text.pack . U.toList) cs' +          : map (Text.pack . U.toList) cs'+      scores = case typ of+                  Soft ->   IntMap.toList +                          . LDA.topicDocs +                          . get ldaModel +                          $ m+                  Hard ->  IntMap.toList+                         . IntMap.fromListWith (IntMap.unionWith (+))+                         . concatMap (\(d,zs) -> [ (z, IntMap.singleton d c) | (z,c) <- zs ])+                         . 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 ]))+                         . IntMap.toList+                         . IntMap.map  IntMap.toList+                         . LDA.docTopics+                         . get ldaModel +                         $ m+                  LLR  -> -- - 2 * logLikelihoodRatio+                    let t = LDA.topicDocs . get ldaModel $ m +                        cs = uncurry Scores.counts . unzip . concat +                             $ [ replicate (round c) (d, z) |+                                 (z, ds) <- IntMap.toList t ,+                                 (d, c) <- IntMap.toList ds ]+                    in [ (z, IntMap.fromList [ (d, let s = - 2 * Scores.logLikelihoodRatio cs d z+                                                   in if isNaN s then -1/0 else s) |+                                               (d, c) <- IntMap.toList ds  ]) |+                         (z, ds) <- IntMap.toList t ]   in fst . flip Atom.runAtom (get wordTypeTable m)      . M.liftM Text.unlines      . mapM format-    . 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-    . get ldaModel -    $ m+    $ scores  -- | @interpWordClasses m lambda doc@ gives the class probabilities for -- word type in context @doc@ according to evolving model @m@. It@@ -284,8 +304,8 @@                s | s >= 1/0 -> uniform                 s -> U.map (/s) x         --- | @wordTypeClasses m@ returns a Map from word types to unnormalized--- distributions over word classes+-- | @wordTypeClasses m@ returns a Map from word types to a table of+-- counts of word classes wordTypeClasses :: WordClass -> Map.Map Text.Text (IntMap.IntMap Double) wordTypeClasses m =         fst . flip Atom.runAtom (get wordTypeTable m) 
colada.cabal view
@@ -1,5 +1,5 @@ Name:                colada-Version:             0.8.0.0+Version:             0.8.3.0 Synopsis:            Colada implements incremental word class class induction                       using online LDA Description:  Colada implements incremental word class class induction using @@ -28,6 +28,7 @@                , bytestring >= 0.9                , mtl >= 2.0                , swift-lda >= 0.7 && < 0.8+               , nlp-scores >= 0.6.3   Exposed-modules:  Colada.WordClass                   , NLP.CoNLL   Other-modules: Colada.Features@@ -51,6 +52,7 @@                , bytestring >= 0.9                , mtl >= 2.0                , swift-lda >= 0.7 && < 0.8+               , nlp-scores >= 0.6.3   Other-modules: Colada.WordClass                , Colada.Features                , NLP.CoNLL
colada.hs view
@@ -13,6 +13,8 @@ import qualified Data.List                  as List import qualified Data.Vector.Generic        as V import qualified Data.Vector.Unboxed        as U+import qualified Data.Map                   as Map+import qualified Data.IntMap                as IntMap import qualified System.Environment         as Env import qualified Data.Label                 as L import qualified Data.Label.Maybe           as M@@ -36,7 +38,8 @@              | Label { _modelPath :: FilePath                       , _noContext :: Bool }              | Summary { _modelPath :: FilePath -                       ,_harden :: Bool }+                       ,_summaryType :: C.SummaryType }+             | WordTypeClasses { _modelPath :: FilePath }               deriving (Show) $(L.mkLabels [''Program])                                       @@ -64,13 +67,24 @@  summary :: Mode Program   summary =-  mode "summary" Summary { _modelPath = "model" , _harden = False } +  mode "summary" Summary { _modelPath = "model" , _summaryType = C.Soft }          "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"+  [ flagReq ["summary-type"] (\x p -> case x of+                               "soft" -> Right $ maybe p id (M.set summaryType  C.Soft p)+                               "hard" -> Right $ maybe p id (M.set summaryType  C.Hard  p)+                               "llr"  -> Right $ maybe p id (M.set summaryType C.LLR p)+                             )+   ("soft|hard|llr") "Type of ranking of words in summary"   ]   +wordTypeClasses :: Mode Program+wordTypeClasses = +  mode "word-type-classes" WordTypeClasses { _modelPath = "model" }+        "Output unnormalized class distribution for each word type"+  (flagArg (\x p -> Right $ maybe p id (M.set modelPath x p)) "FILE")+  [ ]+ label :: Mode Program label =   mode "label" Label { _modelPath = "model" , _noContext = False } @@ -132,7 +146,7 @@    program :: Mode Program                      program = modes "colada" Help "Word class learning" -          [learn, predict, label, summary, help] +          [learn, predict, label, summary, wordTypeClasses, help]    -- Run the program@@ -168,25 +182,37 @@       m <- C.learnIO o display ss       BS.writeFile p . Serialize.encode $ m       -    Summary { _modelPath = p , _harden = h } -> do  +    Summary { _modelPath = p , _summaryType = h } -> do         m <- parseModel p-      if h-        then do Text.putStr . C.summarize True  $ m   -        else do Text.putStr . C.summarize False $ m-      +      Text.putStr . C.summarize h  $ m   ++    WordTypeClasses { _modelPath = p } -> do+      m <- parseModel p+      Text.putStr . formatWordTypeClasses $ m++formatWordTypeClasses :: C.WordClass -> Text.Text+formatWordTypeClasses m =+  let wtc = C.wordTypeClasses m+      size = L.get (C.topicNum . C.options) m+      find t i = IntMap.findWithDefault 0 i t+      tabulate t =   map (Text.pack . Printf.printf "%.1f")+                   . map (find t)+                   $ [0 .. size]+  in   Text.unlines+     . map (\ (k, v) -> Text.unwords $ [k] ++ tabulate v)+     . Map.toList +     $ wtc+ formatLabeling :: (V.Vector v Int, V.Vector v Text.Text) =>      v Int -> Text.Text formatLabeling = Text.unlines . V.toList                   . V.map (Text.toLazyText . Text.decimal) - formatFullLabeling =      Text.unlines    . map (Text.unwords . map (Text.pack . Printf.printf "%.3f") . U.toList)   . V.toList   -  - parseModel :: FilePath -> IO C.WordClass parseModel p = do   (either (\err -> error $ "Error reading model " ++ err) id