estimators 0.1.1 → 0.1.4
raw patch · 7 files changed
+135/−26 lines, 7 filesdep +MonadRandomdep +QuickCheckdep +deepseq
Dependencies added: MonadRandom, QuickCheck, deepseq, mtl
Files
- NLP/Probability/Chain.hs +30/−0
- NLP/Probability/ConditionalDistribution.hs +30/−9
- NLP/Probability/EM.hs +23/−0
- NLP/Probability/Example/Trigram.hs +1/−1
- NLP/Probability/Observation.hs +24/−8
- NLP/Probability/SmoothTrie.hs +17/−2
- estimators.cabal +10/−6
+ NLP/Probability/Chain.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TypeSynonymInstances, TypeSynonymInstances, TypeFamilies, FlexibleInstances, GeneralizedNewtypeDeriving, UndecidableInstances, TemplateHaskell, MultiParamTypeClasses, BangPatterns, StandaloneDeriving #-}+module NLP.Probability.Chain (simpleObserve,+ JointModel (..)+ -- M2(..), M3(..), M4(..), M5(..), M7(..), HolderPretty, holderPretty, hPretty+ ) where +import NLP.Probability.ConditionalDistribution+import NLP.Probability.Distribution +import NLP.Probability.Observation+import qualified Data.Map as M++++class JointModel a where + data FullEvent a+ data FullContext a+ data Probs a+ data Observation a+ data Pairs a + chainRule :: FullEvent a -> FullContext a -> Pairs a+ observe :: Pairs a -> Observation a+ prob :: Probs a -> Pairs a -> Prob+ estimate :: Observation a -> Probs a++class Estimate a where + type Dist a ++instance Event String where type EventMap String = M.Map+instance Event Int where type EventMap Int = M.Map++simpleObserve a b = observe $ chainRule a b
NLP/Probability/ConditionalDistribution.hs view
@@ -6,11 +6,15 @@ CondObserved(), CondDistribution, condObservation,+ condObservations,+ condObservationCounts, Context(..), estimateGeneralLinear, Weighting, wittenBell, - simpleLinear + simpleLinear,+ DebugDist,+ mkDist ) where import qualified Data.ListTrie.Base.Map as M import Data.List (inits)@@ -19,7 +23,7 @@ import NLP.Probability.Distribution import NLP.Probability.Observation import Data.Binary-+import Text.PrettyPrint.HughesPJClass -- $CondDistDesc -- Say we want to estimate a conditional distribution based on a very large set of observed data. -- Naively, we could just collect all the data and estimate a large table, but@@ -40,9 +44,12 @@ -- ++ -- | The set of observations of event conditioned on context. event must be an instance of Event and context of Context type CondObserved event context = (ST.SmoothTrie (SubMap context) (Sub context) (Counts event)) + -- | Events are conditioned on Contexts. When Contexts are sparse, we need a way to decompose into simpler SubContexts. -- This class allows us to separate this decomposition from the collection of larger contexts. class (M.Map (SubMap a) (Sub a)) => Context a where @@ -50,22 +57,35 @@ type Sub a -- | A map over subcontexts (for efficiency) type SubMap a :: * -> * -> * + -- | A function to enumerate subcontexts of a context decompose :: a -> [Sub a] + -- | A CondObserved set for a single event and context. -condObservation :: (Context context, Event event) => - event -> context -> CondObserved event context-condObservation event context = +condObservations :: (Context context, Event event) => + event -> context -> Count -> CondObserved event context+condObservations event context count = ST.addColumn decomp observed mempty - where observed = observation event + where observed = observations event count decomp = decompose context -type CondDistribution event context = context -> Distribution event+condObservation event context = condObservations event context 1.0 +condObservationCounts :: (Context context, Event event) => + context -> Counts event -> CondObserved event context+condObservationCounts context counts =+ ST.addColumn decomp counts mempty + where decomp = decompose context + +type CondDistribution event context = context -> Distribution event+type DebugDist event context =(context -> event -> [(Double,Double)])+ type Weighting = forall a. [Maybe (Observed a)] -> [Double] +mkDist :: DebugDist event context -> CondDistribution event context+mkDist dd context event = sum $ map (uncurry (*)) $ dd context event -- | General Linear Interpolation. Produces a Conditional Distribution from observations. -- It requires a GeneralLambda function which tells it how to weight each level of smoothing. @@ -76,10 +96,10 @@ estimateGeneralLinear :: (Event event, Context context) => Weighting -> CondObserved event context -> - CondDistribution event context+ DebugDist event context estimateGeneralLinear genLambda cstat = conFun where- conFun context = (\event -> sum $ zipWith (*) lambdas $ map (probE event) stats) + conFun context = (\event -> zip lambdas $ map (probE event) stats) where stats = reverse $ Nothing : (map (\k -> Just $ ST.lookupWithDefault (finish mempty) k cstat') $ tail $ inits $ decompose context)@@ -110,4 +130,5 @@ if total cur > 0 then (l*mult : wittenBell' ls ((1-l)*mult)) else (0.0: wittenBell' ls mult) where l = lambdaWBC n cur+
+ NLP/Probability/EM.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE ScopedTypeVariables #-}++module NLP.Probability.EM where +import NLP.Probability.Observation+import NLP.Probability.ConditionalDistribution+import Control.Monad.Random+import Control.Monad (liftM)+import Data.Monoid++randomCounts :: (Bounded event, Enum event, Event event, MonadRandom mr) => + mr (Counts event) +randomCounts = do+ rcounts <- mapM (\e -> do {r <- getRandomR (1, 10); return (e,r)}) [minBound..maxBound]+ return $ mconcat $ map (uncurry observations) rcounts ++randomCondCounts :: (Bounded event, Enum event , Event event ,+ Bounded context, Enum context, Context context,+ MonadRandom mr) => [context] -> mr (CondObserved event context)+randomCondCounts contexts = do+ let r = randomCounts+ condcounts <- mapM (\context -> condObservationCounts context `liftM` r) contexts+ return $ mconcat condcounts+
NLP/Probability/Example/Trigram.hs view
@@ -30,7 +30,7 @@ languageModel :: String -> CondDistribution Word TrigramContext languageModel sentences = - estimateGeneralLinear (wittenBell 5) $ -- (simpleLinear [0.7, 0.3, 0.0]) $ + mkDist $ estimateGeneralLinear (wittenBell 5) $ -- (simpleLinear [0.7, 0.3, 0.0]) $ mconcat $ map makeTrigrams $ T.split "." $ T.pack sentences prob lm (w1, w2, w3) =
NLP/Probability/Observation.hs view
@@ -7,10 +7,11 @@ Counts, Event(..), observation,+ observations, inc, Observed(..),- finish-+ finish,+ showObsPretty ) where import Data.Monoid@@ -19,7 +20,7 @@ import Data.Binary import Text.PrettyPrint.HughesPJClass import qualified Data.ListTrie.Base.Map as M-+import Control.DeepSeq -- $ObsDesc -- This module provides a simple way to collect observations ('counts'), particularly within a monoid. -- Use 'observation' for each observed event and 'mappend' for combining observations. Finally 'finish' before estimating probabilities. @@ -31,16 +32,26 @@ counts :: (EventMap event) event Count } ++ -- | Trivial type family for events. Just use EventMap = M.Map for most cases. Allows clients to specify the type of map used, when efficiency is important. class (M.Map (EventMap event) event) => Event event where type EventMap event :: * -> * -> * -instance (Event event, Show event) => Pretty (Counts event) where - pPrint (Counts counts) = - vcat $ map (\(e,count) -> (text $ show $ e) <+> equals <+> double count ) $ M.toList counts +pShow fn (Counts counts) = vcat $ map (\(e,count) -> (fn e) <+> equals <+> double count ) $ M.toList counts +showObsPretty :: (Event event, Monad m) => (event -> m Doc) -> Counts event -> m Doc +showObsPretty fn mcounts = do + res <- mapM (\(e,count) -> do+ me <- (fn e)+ return (me <+> equals <+> double count) ) $ M.toList $ counts mcounts+ return $ vcat res ++instance (Event event, Pretty event) => Pretty (Counts event) where + pPrint = pShow pPrint+ instance (Event event, Show event) => (Show (Counts event)) where - show = render . pPrint + show = render . pShow (text. show) instance (Event event) => Monoid (Counts event) where mempty = Counts M.empty @@ -51,9 +62,14 @@ put (Counts m) = put m get = Counts `liftM` get +instance (Event event, NFData event) => NFData (Counts event) where + rnf = rnf . M.toList . counts + -- | Observation of a single event observation :: (Event event) => event -> Counts event-observation event = Counts (M.singleton event 1) +observation event = observations event 1.0++observations event count = Counts (M.singleton event count) -- | Manually increment the count of an event inc :: (Event e) => Counts e -> e -> Count -> Counts e
NLP/Probability/SmoothTrie.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, TemplateHaskell #-} module NLP.Probability.SmoothTrie where import Data.Monoid import qualified Data.ListTrie.Map as T@@ -10,11 +10,14 @@ import Data.Binary import Text.PrettyPrint.HughesPJClass import qualified Data.ListTrie.Base.Map as M-+import Control.DeepSeq newtype SmoothTrie map letter holder= SmoothTrie (T.TrieMap map letter holder) deriving (Show, Binary, Functor) +instance (NFData letter, NFData holder, M.Map map letter) => NFData (SmoothTrie map letter holder) where + rnf (SmoothTrie st) = rnf $ T.toList st + instance (M.Map map letter, Arbitrary letter, Arbitrary holder) => Arbitrary (SmoothTrie map letter holder) where arbitrary = do holder <- arbitrary@@ -34,6 +37,18 @@ mempty = SmoothTrie mempty mappend (SmoothTrie m) (SmoothTrie m') = SmoothTrie (T.unionWith mappend m m') mconcat sumtries = SmoothTrie $ T.unionsWith mappend $ [s | SmoothTrie s <-sumtries]++mPretty showEvent showCond (SmoothTrie t) = printRows 1 + where + tlist = T.toList t+ printRows n = if null oflen then return $ empty + else do + ofls <- mapM (\(k,v) -> do {pk<-showCond k; pv <- showEvent v; return (pk,pv) }) oflen+ pr <- printRows (n + 1)+ return (hang (text "Row " <> int n) 4 + $ (vcat $ map (\(k,v) -> k <+>v) ofls) $$ pr) + where oflen = filter ((== n).length.fst) tlist + lookup ks (SmoothTrie t) = T.lookup ks t
estimators.cabal view
@@ -1,5 +1,5 @@ name: estimators-version: 0.1.1+version: 0.1.4 synopsis: Tool for managing probability estimation description: This library provides data structures for collecting counts and estimating distributions from observed data. It is designed for natural language@@ -14,20 +14,24 @@ cabal-version: >= 1.2 library+ ghc-options: -O2 exposed-modules: NLP.Probability.Distribution NLP.Probability.Observation NLP.Probability.ConditionalDistribution+ NLP.Probability.EM NLP.Probability.Example.Trigram -- other-modules: NLP.Probability.SmoothTrie-+ NLP.Probability.Chain,+ NLP.Probability.SmoothTrie build-Depends: base >= 3 && < 4, containers >= 0.1 && < 0.3, binary, list-tries, pretty, prettyclass, - text -+ text,+ deepseq,+ MonadRandom,+ QuickCheck >= 2.0, + mtl