module NLP.Probability.Observation (
Count,
Counts,
Event(..),
observation,
observations,
inc,
Observed(..),
finish,
showObsPretty
) where
import Data.Monoid
import Data.List (intercalate)
import Control.Monad (liftM)
import Data.Binary
import Text.PrettyPrint.HughesPJClass
import qualified Data.ListTrie.Base.Map as M
import Control.DeepSeq
type Count = Double
newtype Counts event = Counts {
counts :: (EventMap event) event Count
}
class (M.Map (EventMap event) event) => Event event where
type EventMap event :: * -> * -> *
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 . pShow (text. show)
instance (Event event) => Monoid (Counts event) where
mempty = Counts M.empty
mappend (Counts a) (Counts b) = Counts $ M.unionWith (+) a b
instance (Event event, Binary event, Binary ((EventMap event) event Count)) =>
Binary (Counts event) where
put (Counts m) = put m
get = Counts `liftM` get
instance (Event event, NFData event) => NFData (Counts event) where
rnf = rnf . M.toList . counts
observation :: (Event event) => event -> Counts event
observation event = observations event 1.0
observations event count = Counts (M.singleton event count)
inc :: (Event e) => Counts e -> e -> Count -> Counts e
inc obs e c = obs {counts = M.insertWith (+) e c $ counts obs}
observedEvents :: (Event event) => Counts event -> [event]
observedEvents (Counts m) = map fst $ filter ((> 0) . snd) $ M.toList m
elems :: (M.Map map event) => map event elem -> [elem]
elems = map snd . M.toList
calcTotal :: (Event event) => Counts event -> Count
calcTotal = sum . elems .counts
countNonTrivial :: (Event event ) => Counts event -> Count
countNonTrivial = fromIntegral .length . filter (>0) . elems . counts
data Observed event = Observed {
observed :: (EventMap event) event Count,
total :: Double
, unique :: Count
}
finish :: (Event event) => Counts event -> Observed event
finish obs = Observed (counts obs) (calcTotal obs) (countNonTrivial obs)