packages feed

colada 0.5.6 → 0.7.0.0

raw patch · 3 files changed

+36/−92 lines, 3 files

Files

Colada/WordClass.hs view
@@ -27,7 +27,7 @@ module Colada.WordClass         (           -- * Running the sampler-         learn+         learnIO        , defaultOptions          -- * Extracting information        , summary@@ -63,19 +63,14 @@          -- | Dirichlet parameter beta which controls word sparseness        , passes          -- | Number of sampling passes per batch-       , repeats-         -- | Number of repeats per sentences        , batchSize          -- | Number of sentences per batch        , seed          -- | Random seed for the sampler        , topn          -- | Number of most probable words to return-       , initSize-       , initPasses        , exponent        , progressive-       , pre        , lambda        ) where       @@ -139,15 +134,11 @@                        , _alphasum   :: !Double                          , _beta       :: !Double                          , _passes     :: !Int     -                       , _repeats    :: !Int                             , _batchSize  :: !Int                            , _seed       :: !Word32                        , _topn       :: !Int-                       , _initSize   :: !Int-                       , _initPasses :: !Int                        , _exponent   :: !(Maybe Double)                        , _progressive :: !Bool-                       , _pre         :: !Bool                        , _lambda     :: !Double                        }              deriving (Eq, Show, Typeable, Data, Generic)@@ -162,84 +153,52 @@                          , _alphasum   = 10                          , _beta       = 0.1                          , _passes     = 1-                         , _repeats    = 1                          , _batchSize  = 1                           , _seed       = 0                           , _topn       = maxBound               -                         , _initSize   = 0-                         , _initPasses = 100                          , _exponent   = Nothing                          , _progressive= False-                         , _pre        = False                                          , _lambda     = 1.0                          }                  --- | @learn options xs@ runs the LDA Gibbs sampler for word classes--- with @options@ on sentences @xs@, and returns the resulting model--- together with progressive class assignments-learn :: Options -         -> [CoNLL.Sentence] -         -> (WordClass, [V.Vector (U.Vector Double)])-learn opts xs = -  let ((bs_init, bs_rest), atomTabD, atomTabW) = -        Symbols.runSymbols prepare Symbols.empty Symbols.empty-      prepare =  do                                        -        let (xs_init, xs_rest) = List.splitAt (get initSize opts) xs-        ini  <- prepareData (get initSize opts)-                                     1-                                     (get featIds opts)-                                     xs_init-        rest <- prepareData (get batchSize opts)-                                   (get repeats opts) -                                   (get featIds opts) -                xs_rest-        return (ini, rest)-      sampler :: WriterT [V.Vector (U.Vector Double)] (LST.ST s) LDA.Finalized+-- | @learnIO options f xs@ runs the LDA Gibbs sampler for word classes+-- with @options@ on sentences @xs@, and returns the resulting+-- model. The progressive class assignments are passed to the handler+-- function f.  +learnIO :: Options +           -> (V.Vector (U.Vector Double) -> IO ())+           -> [CoNLL.Sentence] +           -> IO WordClass+learnIO opts f xs = do +  let (bs, atomTabD, atomTabW) = +        Symbols.runSymbols (prepareData (get batchSize opts) (get featIds opts) xs) +                           Symbols.empty +                           Symbols.empty+      sampler :: IO LDA.Finalized       sampler = do         -        m <- st $ LDA.initial (U.singleton (get seed opts)) +        m <- ST.stToIO $ LDA.initial (U.singleton (get seed opts))                           (get topicNum opts)                          (get alphasum opts)                          (get beta opts)                          (get exponent opts)-        let loop t i_last batch i = do-              let label_prog = do  -                  Fold.forM_ batch $ \rep -> do    -                    let sent = V.head rep-                    ls <- st $ V.mapM (interpWordClasses m (get lambda opts)) sent-                    tell [ls]-              -- Either label before sampling (--pre)-              M.when (get progressive opts && i == 1 && get pre opts) label_prog -              r <- st $ Trav.forM batch $ \rep -> do-                     Trav.forM rep $ \sent -> do-                       LDA.pass t m sent-              -- Or label after sampling    -              M.when (get progressive opts && i == i_last && not (get pre opts)) label_prog -              return $! r-        -- Initialize with batch sampler on prefix sbs_init     -        Fold.forM_ bs_init $ \batch -> do -          Fold.foldlM (loop 1 $ get initPasses opts) batch  [1..get initPasses opts] -        -- Continue sampling-        Fold.forM_ (zip [1..] bs_rest) $ \(t, batch) -> do-          Fold.foldlM (loop t $ get passes opts) batch [1..get passes opts]-        st $ LDA.finalize m    -      (lda, labeled) = LST.runST (runWriterT sampler)-  in (WordClass lda atomTabD atomTabW opts, labeled)+        Fold.forM_ bs $ \b -> do+          Fold.forM_ [1..get passes opts] $ \i -> do+            Fold.forM_ b $ \sent -> do+              _ <- ST.stToIO $ LDA.pass 1 m sent+              when (get progressive opts && i == get passes opts) $ do+                ls <- ST.stToIO $ V.mapM (interpWordClasses m (get lambda opts)) sent+                f ls+        ST.stToIO $ LDA.finalize m    +  lda <- sampler+  return (WordClass lda atomTabD atomTabW opts)  type Symb  = Symbols.Symbols (U.Vector Char) (U.Vector Char) type Sent  = V.Vector LDA.Doc-type Repeat = V.Vector Sent-type Batch = V.Vector Repeat --- | Convert a stream of sentences into a stream of batches ready for--- sampling.-prepareData ::   Int                          -- ^ batch size -               -> Int                         -- ^ no. repeats -               -> [Int]                       -- ^ feature indices-               -> [CoNLL.Sentence]            -- ^ stream of sentences-               -> Symb [Batch]                -- ^ stream of batches-prepareData bsz rep is ss = do+prepareData :: Int -> [Int] -> [CoNLL.Sentence] -> Symb [V.Vector Sent]+prepareData bsz is ss = do    ss' <- mapM symbolize . map (featurize is) $ ss-  return $! (map V.fromList . Split.chunksOf bsz . map (V.replicate rep) $ ss')+  return $! map V.fromList . Split.chunksOf bsz $ ss'   -- | Extract features from a sentence featurize :: [Int] 
colada.cabal view
@@ -1,5 +1,5 @@ Name:                colada-Version:             0.5.6+Version:             0.7.0.0 Synopsis:            Colada implements incremental word class class induction                       using online LDA Description:  Colada implements incremental word class class induction using @@ -55,4 +55,4 @@                , Colada.Features                , NLP.CoNLL                , NLP.Symbols-  GHC-options: -O2 -rtsopts+  GHC-options: -O2 -with-rtsopts=-K128m -rtsopts
colada.hs view
@@ -113,9 +113,6 @@         , flagReq ["passes"] (setOption C.passes)             "NAT" "Passes per batch"           -        , flagReq ["repeats"] (setOption C.repeats)-            "NAT" "Repeats per sentence"-                   , flagReq ["batch-size"] (setOption C.batchSize)             "NAT" "Sentences per batch"           @@ -127,22 +124,9 @@              maybe p id . M.set (C.progressive . options) True $ p)                   "Label progressively"           -        , flagNone ["pre"]  -            (\p -> -              maybe p id . M.set (C.pre . options) True $ p)-                  "Progressive labeling done before running a pass"-                   , flagReq ["lambda"] (setOption C.lambda)              "FLOAT" "Interpolation parameter for progressive labeling"           -        , flagReq ["init-size"] (setOption C.initSize) -            "NAT" "Data prefix size for batch initialization"-          -        , flagReq ["init-passes"] (setOption C.initPasses)-            "NAT" "Number of passes for initialization"-          -        , flagReq ["exponent"] (setOptionWith Just C.exponent)            -            "FLOAT" "Exponent for learning rate"         ]            @@ -178,11 +162,12 @@         $ ss       Learn { _options = o , _modelPath = p } -> do       ss <- CoNLL.parse `fmap` Text.getContents-      let (m, ls) = C.learn o ss-      if (L.get C.progressive o)     -        then do Text.putStr . Text.unlines . map formatFullLabeling $ ls-        else do Text.putStr . C.summary $ m    +      let display x = if L.get C.progressive o +                      then Text.putStrLn . formatFullLabeling $ x+                      else return ()+      m <- C.learnIO o display ss       BS.writeFile p . Serialize.encode $ m      +     Summary { _modelPath = p , _harden = h } -> do         m <- parseModel p       if h