packages feed

lda (empty) → 0.0.1

raw patch · 7 files changed

+410/−0 lines, 7 filesdep +basedep +containersdep +ghc-primsetup-changed

Dependencies added: base, containers, ghc-prim, mtl, random-fu, random-source, rvar, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Grzegorz Chrupala++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Grzegorz Chrupala nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ NLP/LDA.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE  DeriveGeneric , BangPatterns #-}+-- | Latent Dirichlet Allocation+--+-- Simple implementation of a collapsed Gibbs sampler for LDA. This+-- library uses the topic modeling terminology (documents, words,+-- topics), even though it is generic. For example if used for word+-- class induction, replace documents with word types, words with+-- features and topics with word classes.++module NLP.LDA+       ( -- * Running samplers+         runSampler+       , pass+       , runLDA+         -- * Datatypes+       , Sampler +       , LDA+       , Finalized+       , Doc+       , D+       , W+       , Z+         -- * Access model information+       , docTopics+       , wordTopics+       , topics+       , alphasum+       , beta+       , topicNum+       , vSize+       , model+       , topicDocs+       , topicWords+         -- * Initialization and finalization+       , initial+       , finalize+         -- * Prediction+       , docTopicWeights+         -- * Miscelaneous+       , compress+       , Table2D+       , Table1D+       )+where       +-- Standard libraries  +import qualified Data.IntMap as IntMap  +import qualified Data.Vector.Unboxed as U+import qualified Data.Vector as V+import qualified Data.List as List+import Prelude hiding (sum)++-- Third party module+import GHC.Generics (Generic)+import Data.Random (rvarT)+import Data.RVar+import Data.Random.Distribution.Categorical +import Control.Monad.State+import Data.Random.Source.PureMT (pureMT)+import Data.Word (Word64)++-- Package modules+import NLP.LDA.Utils (count)+import NLP.LDA.UnboxedMaybeVector () ++-- Exported types+type D = Int+type Z = Int  +type W = Int+type Doc = (D, U.Vector (W, Maybe Z))++type Table2D = IntMap.IntMap Table1D+type Table1D = IntMap.IntMap Double++-- | Abstract type holding the settings and the state of the sampler+data LDA = +  LDA +  { docTopics   :: Table2D -- ^ Document-topic counts+  , wordTopics  :: Table2D -- ^ Word-topic counts+  , topics      :: Table1D -- ^ Topic counts+  , alphasum    :: !Double -- ^ alpha * K Dirichlet parameter (topic sparseness)+  , beta        :: !Double -- ^ beta Dirichlet parameter (word sparseness)+  , topicNum    :: !Int    -- ^ Number of topics K+  , vSize       :: !Int    -- ^ Number of unique words+  } deriving (Generic)++-- | Abstract type holding the LDA model, and the inverse count tables+data Finalized = +  Finalized +  { model :: LDA         -- ^ LDA model+  , topicDocs :: Table2D   -- ^ Inverse document-topic counts+  , topicWords :: Table2D  -- ^ Inverse word-topic counts+  }+  deriving (Generic)++-- | Custom random variable representing the LDA Gibbs sampler+type Sampler a =  RVarT (State LDA) a+         +-- Exported functions  +         +-- | @initial k a b@ initializes model with @k@ topics, @a/k@ alpha+-- hyperparameter and @b@ beta hyperparameter.+initial :: Int -> Double -> Double -> LDA+initial k a b = +  LDA { docTopics  = IntMap.empty+        , wordTopics = IntMap.empty+        , topics     = IntMap.empty+        , alphasum   = a+        , beta       = b+        , topicNum   = k +        , vSize      = 0                       +        }+  +-- | @finalize m@ creates a finalized model from LDA model @m@+finalize :: LDA -> Finalized  +finalize m = +  Finalized { model = m +            , topicDocs =  invert . docTopics $ m+            , topicWords = invert . wordTopics $ m }++++-- | @pass batch@ runs one pass of Gibbs sampling on documents in @batch@  +pass :: V.Vector Doc ->  Sampler (V.Vector Doc)+pass = V.mapM passOne+++-- | @runSampler seed m s@ runs sampler @s@ with @seed@ and initial+-- model @m@. The random number generator used is+-- System.Random.Mersenne.Pure64.+runSampler :: Word64 -> LDA -> Sampler a -> (a, LDA)+runSampler seed m =    +     flip runState m+   . flip evalStateT (pureMT seed)+   . sampleRVarTWith lift ++   +-- | @runLDA seed n m ds@ creates and runs an LDA sampler with @seed@+-- for @n@ passes with initial model @m@ on the batch of documents+-- @ds@. The random number generator used is+-- System.Random.Mersenne.Pure64.+runLDA :: Word64 +            -> Int +            -> LDA +            -> V.Vector Doc +            -> (V.Vector Doc, LDA)+runLDA seed n m ds = runSampler seed m . foldM (const . pass) ds +                     $ [1..n]++-- | Remove zero counts from the doc/topic table+compress :: IntMap.IntMap (IntMap.IntMap Double) +            -> IntMap.IntMap (IntMap.IntMap Double) +compress = IntMap.map dezero++-- Private functions --++-- | Run a pass on a single doc+passOne :: Doc -> Sampler Doc+passOne (d, wz) = do +  zs <- U.mapM one wz+  return (d, U.zip (U.map fst wz) (U.map Just zs))+  where one (w, mz) = do+          m <- lift get+          let m' = maybe m (update (-1) m d w) mz -- decrement counts+          lift $ put m'+          z <- randomZ d w                        -- sample topic+          lift $ put (update 1 m' d w z)          -- increment counts+          return z++-- | Sample a random topic for doc d and word w+randomZ :: D -> W -> Sampler Z+randomZ d w = do+  m <- lift get+  sampleCategorical . fromWeightedList . U.toList . U.map swap . U.indexed +    . wordTopicWeights m d +    $ w+    +-- | @topicWeights m d w@ returns the unnormalized probabilities of+-- topics for word @w@ in document @d@ given LDA model @m@.+wordTopicWeights :: LDA -> D -> W -> U.Vector Double+wordTopicWeights m d w =+  let k = topicNum m+      a = alphasum m / fromIntegral k+      b = beta m+      dt = IntMap.findWithDefault IntMap.empty d . docTopics $ m+      wt = IntMap.findWithDefault IntMap.empty w . wordTopics $ m+      v = fromIntegral . vSize $ m+      weights = [   (count z dt + a)     -- n(z,d) + alpha +                  * (count z wt + b)     -- n(z,w) + beta+                  * (1/(count z (topics m) + v * b)) +                      -- n(.,w) + V * beta+                  | z <- [0..k-1] ]+  in U.fromList weights+{-# INLINE wordTopicWeights #-}++-- | @docTopicWeights m doc@ returns unnormalized topic probabilities+-- for document doc given LDA model @m@+docTopicWeights :: LDA -> Doc -> U.Vector Double+docTopicWeights m (d, ws) = +    U.accumulate (+) (U.replicate (topicNum m) 0)+  . U.concatMap (U.indexed . wordTopicWeights m d)+  . U.map fst +  $ ws+{-# INLINE docTopicWeights #-}+  +-- | Update counts in the model corresponding to given doc, word and topic+update :: Double -> LDA -> D -> W -> Z -> LDA+update c m d w z = +  m { docTopics  = upd c (docTopics m) d z+    , wordTopics = upd c (wordTopics m) w z+    , topics = IntMap.insertWith' (+) z c (topics m) +    , vSize = vSize m + (fromEnum . IntMap.notMember w . wordTopics $ m)+    }+  +-- FIXME: define a more efficient version+-- | Increment table m by c at key (k,k')+upd :: Double -> Table2D -> Int -> Int -> Table2D+upd c m k k' = IntMap.insertWith' (flip (IntMap.unionWith (+)))+                               k +                               (IntMap.singleton k' c)+                               m+{-# INLINE upd #-}++sampleCategorical :: Categorical Double Z -> Sampler Z+sampleCategorical = sampleRVarT . rvarT +{-# INLINE sampleCategorical #-}++dezero :: IntMap.IntMap Double -> IntMap.IntMap Double+dezero = IntMap.filter (/=0)+{-# INLINE dezero #-}++-- | Swap the order of keys on Table2D+invert :: Table2D -> Table2D+invert outer = +  List.foldl' (\z (k,k',v) -> upd v z k k')  IntMap.empty +  [ (k',k,v)+    | (k, inner) <- IntMap.toList outer+    , (k', v) <- IntMap.toList inner ]+{-# INLINE invert #-}++swap :: (Int, Double) -> (Double, Int)+swap (!a, !b) = (b, a)
+ NLP/LDA/UnboxedMaybeVector.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FlexibleContexts,+             TypeFamilies, ScopedTypeVariables, BangPatterns,  +             TupleSections  #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module NLP.LDA.UnboxedMaybeVector ()+where+import qualified Data.Vector.Generic         as G+import qualified Data.Vector.Generic.Mutable as M+import Data.Vector.Unboxed.Base (MVector, Vector, Unbox)++import Control.Monad ( liftM )++newtype instance MVector s (Maybe a) = MV_Maybe (MVector s (a,Bool))+newtype instance Vector    (Maybe a) = V_Maybe  (Vector    (a,Bool))++instance (Num a, Unbox a) => Unbox (Maybe a)++nothing :: (Num a, Unbox a) => a+nothing = 0+{-# INLINE nothing #-}++instance (Num a, Unbox a) => M.MVector MVector (Maybe a) where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicOverlaps #-}+  {-# INLINE basicUnsafeNew #-}+  {-# INLINE basicUnsafeRead #-}+  {-# INLINE basicUnsafeWrite #-}+  basicLength (MV_Maybe v) = M.basicLength v+  basicUnsafeSlice i n (MV_Maybe v) = MV_Maybe $ M.basicUnsafeSlice i n v+  basicOverlaps (MV_Maybe v1) (MV_Maybe v2) = M.basicOverlaps v1 v2+  basicUnsafeNew n = MV_Maybe `liftM` M.basicUnsafeNew n+  basicUnsafeRead (MV_Maybe v) i = fromPair `liftM` M.basicUnsafeRead v i+  basicUnsafeWrite (MV_Maybe v) i mx = M.basicUnsafeWrite v i (maybe (nothing,False) (,True) mx)+  +instance (Num a, Unbox a) => G.Vector Vector (Maybe a) where+  {-# INLINE basicLength #-}+  {-# INLINE basicUnsafeFreeze #-}+  {-# INLINE basicUnsafeThaw #-}+  {-# INLINE basicUnsafeSlice #-}+  {-# INLINE basicUnsafeIndexM #-}+  basicLength (V_Maybe v) = G.basicLength v+  basicUnsafeFreeze (MV_Maybe v) = V_Maybe `liftM` G.basicUnsafeFreeze v+  basicUnsafeThaw (V_Maybe v) = MV_Maybe `liftM` G.basicUnsafeThaw v+  basicUnsafeSlice i n (V_Maybe v) = V_Maybe $ G.basicUnsafeSlice i n v+  basicUnsafeIndexM (V_Maybe v) i+                = fromPair `liftM` G.basicUnsafeIndexM v i+                  +fromPair :: (Unbox a) => (a, Bool) -> Maybe a                  +fromPair (_, False) = Nothing+fromPair (x, True)  = Just x+{-# INLINE fromPair #-}
+ NLP/LDA/Utils.hs view
@@ -0,0 +1,12 @@+module NLP.LDA.Utils+       ( count+       )+where       +import qualified Data.IntMap as IntMap  ++count :: Int -> IntMap.IntMap Double -> Double+count z t = case IntMap.findWithDefault 0 z t of+        n | n < 0 -> error "NLP.LDA.Utils.count: negative count"+        n -> n+{-# INLINE count #-}   +
+ README view
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lda.cabal view
@@ -0,0 +1,73 @@+-- lda.cabal auto-generated by cabal init. For additional options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                lda++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.0.1++-- A short (one-line) description of the package.+Synopsis:            Online Latent Dirichlet Allocation++-- A longer description of the package.+Description:     Online Gibbs sampler for Latent Dirichlet Allocation. +                 LDA is a generative admixture model frequently used +                 for topic modeling and other applications. The primary+                 goal of this implementation is to be used for probabilistic +                 soft word class induction.+                 The sampler can be used in an online as well as batch mode.++-- URL for the project homepage or repository.+Homepage:            https://bitbucket.org/gchrupala/colada++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Grzegorz Chrupała++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          pitekus@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Natural Language Processing+++-- Extra files to be distributed with the package, such as examples or+-- a README.+Extra-source-files:  README++Build-type:          Simple++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2+++Library+  -- Modules exported by the library.+   Exposed-modules: NLP.LDA+                  , NLP.LDA.UnboxedMaybeVector+  +  -- Packages needed in order to build this package.+   Build-depends: base >= 3 && < 5+                , containers >= 0.4    +                , random-fu >= 0.2.1.1+                , rvar >= 0.2+                , random-source >= 0.3.0.2+                , mtl >= 2.0+                , ghc-prim >= 0.2+                , vector >= 0.9+  -- Modules not exported by this package.+  Other-modules: NLP.LDA.Utils+  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +  GHC-options: -O2