colada (empty) → 0.0.1
raw patch · 7 files changed
+620/−0 lines, 7 filesdep +ListZipperdep +basedep +bytestringsetup-changed
Dependencies added: ListZipper, base, bytestring, cereal, cmdargs, containers, fclabels, ghc-prim, lda, monad-atom, split, text, vector
Files
- Colada/Features.hs +39/−0
- Colada/WordClass.hs +304/−0
- LICENSE +30/−0
- NLP/CoNLL.hs +27/−0
- Setup.hs +2/−0
- colada.cabal +75/−0
- colada.hs +143/−0
+ Colada/Features.hs view
@@ -0,0 +1,39 @@+module Colada.Features + ( features + , featureSeq+ )+where +import Data.List.Zipper +import qualified Data.IntMap as IntMap ++-- | @featureSeq f z@ extracts features at each position of z+-- following current position, using f to combine features into bigrams.+featureSeq:: (Maybe a -> Maybe a -> Maybe a)+ -> Zipper a + -> [IntMap.IntMap a]+featureSeq (+++) = foldrz (\zi z -> features (+++) zi : z) []++-- | @features f z@ extracts features at the current position of z,+-- using f to combine features into bigrams.+features :: (Maybe a -> Maybe a -> Maybe a) -> Zipper a -> IntMap.IntMap a+features (+++) z = + let fs = [ + (0 , at 0 z )+ , (-2, at (-2) z )+ , (-1, at (-1) z )+ , (-12, at (-2) z +++ at (-1) z)+ , (12, at 1 z +++ at 2 z)+ , (1, at 1 z)+ , (2, at 2 z)+ ]+ in IntMap.fromList [ (k, v) | (k,Just v) <- fs ] ++at :: Int -> Zipper a -> Maybe a+at i (Zip ls _) | i < 0 = index (negate i) ls+at i (Zip _ rs) | i > 0 = index (i+1) rs+at _ z = safeCursor z -- i == 0++index :: Num a => a -> [b] -> Maybe b+index 1 (x:_) = Just x+index _ [] = Nothing+index i (_:xs) = index (i-1) xs
+ Colada/WordClass.hs view
@@ -0,0 +1,304 @@+{-# LANGUAGE + OverloadedStrings + , FlexibleInstances+ , DeriveGeneric + , NoMonomorphismRestriction + , DeriveDataTypeable+ , TemplateHaskell+ #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- | Word Class induction with LDA+--+-- This module provides function which implement word class induction+-- using the generic algorithm implemented in Colada.LDA. +--+-- You can access and set options in the @Options@ record using lenses.+-- Example:+--+-- > import Data.Label+-- > let options = set passes 5 +-- > . set beta 0.01 +-- > . set topicNum 100 +-- > $ defaultOptions+-- > in run options sentences++module Colada.WordClass + ( + -- * Running + run+ , defaultOptions+ , summary+ -- * Class and word prediction+ , label+ , predict+ -- * Data types and associated lenses+ , WordClass + , ldaModel+ -- | LDA model+ , atomTable+ -- | String to atom and vice versa conversion tables+ , options+ -- | Options for Gibbs sampling+ , Options+ , featIds+ -- | Feature ids+ , topicNum+ -- | Number of topics K+ , alphasum+ -- | Dirichlet parameter alpha*K which controls topic sparseness+ , beta+ -- | 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+ )+where + +-- Standard libraries +import qualified Data.Text.Lazy as Text+import qualified Data.Text.Lazy.Encoding as Text+import qualified Data.Vector as V+import qualified Data.Vector.Generic as G+import qualified Data.Vector.Unboxed as U+import qualified Data.IntMap as IntMap+import qualified Data.Serialize as Serialize+import qualified Control.Monad as M+import qualified Data.List as List+import qualified Data.List.Split as Split+import qualified Data.Ord as Ord+import Data.Word (Word64)+import Data.Typeable (Typeable)+import Data.Data (Data)+import Prelude hiding ((.))+import Control.Category ((.))++-- Third party modules +import qualified Control.Monad.Atom as Atom+import qualified NLP.CoNLL as CoNLL+import qualified Data.List.Zipper as Zipper+import GHC.Generics (Generic)+import qualified Data.Label as L+import Data.Label (get)++import qualified NLP.LDA as LDA+import NLP.LDA.Utils (count)++-- Package modules+import qualified Colada.Features as F+++-- | Container for the Word Class model+data WordClass = + WordClass { _ldaModel :: LDA.Finalized -- ^ LDA model+ , _atomTable :: Atom.AtomTable (U.Vector Char) -- ^ String to+ -- Int+ -- conversion+ -- table+ , _options :: Options + }+ deriving (Generic)++data Options = Options { _featIds :: [Int]+ , _topicNum :: !Int + , _alphasum :: !Double + , _beta :: !Double + , _passes :: !Int + , _repeats :: !Int + , _batchSize :: !Int + , _seed :: !Word64 + }+ deriving (Eq, Show, Typeable, Data, Generic)++instance Serialize.Serialize Options++$(L.mkLabels [''WordClass, ''Options])++defaultOptions :: Options+defaultOptions = Options { _featIds = [-1,1]+ , _topicNum = 10 + , _alphasum = 10+ , _beta = 0.1+ , _passes = 1+ , _repeats = 1+ , _batchSize = 1 + , _seed = 0 + }+ +-- | @run options xs@ runs the LDA Gibbs sampler for word classes with+-- @options@ on sentences @xs@, and returns the resulting model+run :: Options -> [CoNLL.Sentence] -> WordClass+run opts xs = + let (ss, atomTab) = flip Atom.runAtom Atom.empty + . prepareData (get repeats opts)+ (get featIds opts)+ $ xs+ bs = batches (get batchSize opts) ss + m = LDA.initial (get topicNum opts) (get alphasum opts) (get beta opts)+ lda = mapM_ (\b -> M.foldM (const . LDA.pass) b [1..get passes opts]) + bs+ m' = snd . LDA.runSampler (get seed opts) m $ lda+ in WordClass (LDA.finalize m') atomTab opts ++++-- | @prepareData rep is ss@ replicates each sentence in stream @ss@+-- @rep@ times. Features with indices @is@ are extracted from each+-- token, and word and features are converted to ints in the Atom+-- Monad.+prepareData :: Int + -> [Int] + -> [CoNLL.Sentence]+ -> Atom.Atom (U.Vector Char) [V.Vector LDA.Doc]+prepareData rep is ss = do+ let mk fs = let d = IntMap.findWithDefault + (error "parseData: focus feature missing") 0 fs+ ws = [ Text.concat [f,"^",Text.pack . show $ i ] + | i <- is , Just f <- [IntMap.lookup i fs] ]+ in (d, ws)+ doc (d, ws) = do+ da <- Atom.toAtom . compress $ d+ was <- mapM (Atom.toAtom . compress) ws+ return (da, U.fromList $ zip was (repeat Nothing))+ sent s = do fs <- mapM (doc . mk) . extractFeatures $ s+ return $! V.fromList fs+ ss' <- mapM sent ss+ return $! concatMap (replicate rep) ss'+ +-- | @batches sz ss@ creates batches of size @sz@ from the stream of+-- sentence feature vectors @ss@. The vectors in a batch are+-- concatenated.+batches :: Int -> [V.Vector LDA.Doc] -> [V.Vector LDA.Doc]+batches sz = map V.concat . Split.chunk sz++-- | @summary m@ returns a textual summary of word classes found in+-- model @m@+summary :: WordClass -> Text.Text+summary m = + let 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' + in fst . flip Atom.runAtom (get atomTable m) + . M.liftM Text.unlines + . mapM format+ . IntMap.toList+ . IntMap.fromListWith (IntMap.unionWith (+))+ . concatMap (\(d,zs) -> [ (z, IntMap.singleton d c) | (z,c) <- zs ])+ . IntMap.toList+ . IntMap.map IntMap.toList+ . LDA.docTopics+ . LDA.model+ . get ldaModel + $ m+++-- | @label m s@ returns for each word in sentences s, unnormalized+-- probabilities of word classes.+label :: WordClass -> CoNLL.Sentence -> V.Vector (U.Vector Double)+label m s = fst . Atom.runAtom label' . L.get atomTable $ m+ where label' = do+ let fm = L.get ldaModel m+ s' <- prepareSent m s+ return $! V.map (LDA.docTopicWeights . LDA.model $ fm) $ s'+ +-- | @predict m s@ returns for each word in sentence s, unnormalized+-- probabilities of words given predicted word class.+predict :: WordClass -> CoNLL.Sentence + -> V.Vector (V.Vector (Double, Text.Text))+predict m s = fst . Atom.runAtom predict' . L.get atomTable $ m+ where predict' = do+ let fm = L.get ldaModel m+ s' <- prepareSent m s+ let ws = V.map (G.convert . predictDoc fm . docToWs) + $ s'+ V.mapM (V.mapM fromAtom) ws+ docToWs = U.map fst . snd+ fromAtom (n,w) = do w' <- Atom.fromAtom w+ return (n, decompress w')++prepareSent :: WordClass -> CoNLL.Sentence + -> Atom.Atom (U.Vector Char) (V.Vector LDA.Doc)+prepareSent m s = do + [r] <- prepareData 1 (L.get (featIds . options) m) [s]+ return r++-- | @predictDoc m ws@ returns unnormalized probabilities of each+-- document id given the model @m@ and words @ws@. The candidate+-- document ids are taken from the model @m@. The weights are+-- computed according to the following formula:+-- +-- > P(d|{w}) ∝ Σ_z[n(d,z)+a Σ_{w in ws}(n(w,z)+b)/(Σ_{w in V} n(w,z)+b)]+predictDoc :: LDA.Finalized -> U.Vector LDA.W -> U.Vector (Double, LDA.D)+predictDoc m ws =+ let k = LDA.topicNum . LDA.model $ m+ a = LDA.alphasum (LDA.model m) / fromIntegral k+ b = LDA.beta . LDA.model $ m+ v = fromIntegral . LDA.vSize . LDA.model $ m+ zt = LDA.topics . LDA.model $ m+ wsums = + IntMap.fromList + [ (z, U.sum . U.map (\w -> (count w wt_z + b) / denom) $ ws)+ | z <- IntMap.keys zt+ , let wt_z = IntMap.findWithDefault IntMap.empty z . LDA.topicWords + $ m+ denom = count z zt + b * v ]+ wsum z = IntMap.findWithDefault + (error "Colada.LDA.predictDoc: key not found")+ z wsums+ in U.fromList + . List.sortBy (flip $ Ord.comparing id) + $ [ ( sum [ (c + a) * wsum z | (z,c) <- IntMap.toList zt_d ] , d)+ | d <- IntMap.keys . LDA.docTopics . LDA.model $ m+ , let zt_d = IntMap.findWithDefault IntMap.empty d + . LDA.docTopics + . LDA.model+ $ m ]++extractFeatures :: CoNLL.Sentence -> [IntMap.IntMap Text.Text]+extractFeatures = F.featureSeq combine + . Zipper.fromList + . map (V.! 0) + . V.toList+ +combine :: Maybe Text.Text -> Maybe Text.Text -> Maybe Text.Text+combine (Just a) (Just b) = Just $ Text.concat [a, "|", b]+combine (Just a) Nothing = Just a+combine Nothing (Just b) = Just b+combine Nothing Nothing = Nothing+ ++++compress :: Text.Text -> U.Vector Char+compress = U.fromList . Text.unpack++decompress :: U.Vector Char -> Text.Text+decompress = Text.pack . U.toList++-- Instances for serialization++instance Serialize.Serialize LDA.Finalized+instance Serialize.Serialize LDA.LDA++instance Serialize.Serialize Text.Text where+ put = Serialize.put . Text.encodeUtf8+ get = Text.decodeUtf8 `fmap` Serialize.get+ +instance Serialize.Serialize (U.Vector Char) where+ put v = Serialize.put (Text.pack . U.toList $ v)+ get = + do t <- Serialize.get+ return $! U.fromList . Text.unpack $ t+ +instance Serialize.Serialize (Atom.AtomTable (U.Vector Char))++instance Serialize.Serialize WordClass
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Grzegorz Chrupała++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 Chrupała 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/CoNLL.hs view
@@ -0,0 +1,27 @@+module NLP.CoNLL + ( Token + , Field+ , Sentence + , parse + )+where+import qualified Data.Text.Lazy as Text +import Data.List.Split +import qualified Data.Vector as V+-- | @Token@ is a representation of a word, which consists of a number of fields.+type Token = V.Vector Text.Text++-- | @Field@ is a part of a word token, such as word form, lemma or POS tag +type Field = Text.Text++-- | @Sentence@ is a vector of tokens.+type Sentence = V.Vector Token++-- | @parse text@ returns a lazy list of sentences.+parse :: Text.Text -> [Sentence]+parse = + map V.fromList + . splitWhen V.null+ . map (V.fromList . Text.words)+ . Text.lines +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ colada.cabal view
@@ -0,0 +1,75 @@+-- colada.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: colada++-- 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: Colada implements incremental word class class induction using online LDA++-- A longer description of the package.+Description: Colada implements incremental word class class induction using + Latent Dirichlet Allocation (LDA) with an Online Gibbs sampler. ++-- 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++Build-type: Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files: ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version: >=1.2+++Executable colada+ -- .hs or .lhs file containing the Main module.+ Main-is: colada.hs+ + -- Packages needed in order to build this package.+ Build-depends: base >= 3 && < 5+ , lda >= 0.0.2 && < 0.1+ , containers >= 0.4+ , ListZipper >= 1.2+ , fclabels >= 1.1+ , ghc-prim >= 0.2+ , vector >= 0.9+ , split >= 0.1.4+ , text >= 0.11.1+ , monad-atom >= 0.4 && < 1+ , cereal >= 0.3.5+ , cmdargs >= 0.9+ , bytestring >= 0.9+ -- Modules not exported by this package.+ Other-modules: Colada.WordClass+ , Colada.Features+ , NLP.CoNLL+ + -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+ -- Build-tools: + GHC-options: -O2 -rtsopts
+ colada.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE FlexibleInstances , DeriveDataTypeable + , TemplateHaskell , OverloadedStrings+ #-}+module Main+where +import qualified Data.Text.Lazy.IO as Text+import qualified Data.Text.Lazy as Text+import qualified Data.Text.Lazy.Builder as Text+import qualified Data.Text.Lazy.Builder.Int as Text+import qualified Data.ByteString as BS+import qualified Data.Serialize as Serialize+import qualified Data.List as List+import qualified Data.Vector.Generic as V++import qualified System.Environment as Env+import System.Console.CmdArgs.Explicit+import qualified Data.Label as L+import qualified Data.Label.Maybe as M+import Prelude hiding ((.))+import Control.Category ((.))++import qualified NLP.CoNLL as CoNLL+import qualified Colada.WordClass as C++-- Command line parsing++data Program = Help + | Learn { _options :: C.Options + , _modelPath :: FilePath }+ | Predict { _modelPath :: FilePath }+ | Label { _modelPath :: FilePath }+ deriving (Show)+$(L.mkLabels [''Program]) ++help :: Mode Program+help = + mode "help" Help "Display help" + (flagArg (\ x _ -> + Left $ "Unexpected argument " ++ x) "")+ []++predict :: Mode Program+predict = + mode "predict" Predict { _modelPath = "model" } "Predict words"+ (flagArg (\x p -> Right $ maybe p id (M.set modelPath x p)) "FILE")+ []++label :: Mode Program+label =+ mode "label" Label { _modelPath = "model" } "Label words with classes"+ (flagArg (\x p -> Right $ maybe p id (M.set modelPath x p)) "FILE")+ []+ +learn :: Mode Program+learn = + let setOption field x p = + fmap (maybe p id . flip (M.set (field . options)) p)+ . safeRead + $ x + safeRead :: Read b => String -> Either String b+ safeRead x = + case reads x of+ [(a,"")] -> Right a+ _ -> Left $ "Couldn't parse " ++ show x+ in mode "learn" Learn { _options = C.defaultOptions + , _modelPath = "model" } "Learn word classes"+ (flagArg (\x p -> Right $ maybe p id (M.set modelPath x p))+ "FILE")+ [ flagReq ["features"] + (\x p -> case x of + "unigram" -> Right . maybe p id + $ M.set (C.featIds . options) [-1,1] p+ "bigram" -> Right . maybe p id + $ M.set (C.featIds . options) [-12,12] p+ _ -> Left $ "Unknown feature specification " ++ x)+ "(unigram|bigram)" "Feature specification"+ + , flagReq ["topic-num"] (setOption C.topicNum)+ "NAT" "Number of topics K" + + , flagReq ["alphasum"] (setOption C.alphasum)+ "FLOAT" "Parameter alpha * K"+ + , flagReq ["beta"] (setOption C.beta) + "FLOAT" "Parameter beta"+ + , 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"+ + , flagReq ["seed"] (setOption C.seed)+ "NAT" "Random seed"+ ]+ + +program :: Mode Program +program = modes "colada" Help "Word class learning" + [learn, predict, label, help] +++-- Run the program++main :: IO ()+main = do+ args <- Env.getArgs+ let opts = processValue program args+ case opts of+ Help -> print $ helpText [] HelpFormatDefault program+ Predict { _modelPath = p } -> do+ -- FIXME: use Data.Text.Builder instead of converting to Lists+ let format s = {-# SCC "format" #-}+ Text.unlines + [ Text.concat . List.intersperse "," . map snd . V.toList + $ ws + | ws <- V.toList s ]+ m <- parseModel p+ ss <- CoNLL.parse `fmap` Text.getContents+ Text.putStr . Text.unlines . map (format . C.predict m) $ ss+ Label { _modelPath = p } -> do+ let format s = Text.unlines + . V.toList + . V.map (Text.toLazyText . Text.decimal . V.maxIndex) + $ s+ m <- parseModel p+ ss <- CoNLL.parse `fmap` Text.getContents+ Text.putStr . Text.unlines . map (format . C.label m) $ ss + Learn { _options = o , _modelPath = p } -> do+ ss <- CoNLL.parse `fmap` Text.getContents+ let m = C.run o ss+ Text.putStr . C.summary $ m+ BS.writeFile p . Serialize.encode $ m++parseModel :: FilePath -> IO C.WordClass+parseModel p = do+ (either (\err -> error $ "Error reading model " ++ err) id+ . Serialize.decode)+ `fmap` BS.readFile p+