module NLP.GenI.Statistics(Statistics, StatisticsState, StatisticsStateIO,
emptyStats,
printOutAllMetrics, printOutAllMetrics', printOutInspectionMetrics,
showFinalStats,
initialStatisticsStateFor,
addMetric, addInspectionMetric, setPrintOutInterval,
mergeMetrics,
Metric(IntMetric), queryMetrics, updateMetrics,
incrIntMetric, queryIntMetric, addIntMetrics,
) where
import Control.Monad.State
import Data.Maybe (mapMaybe)
import Data.List (intersperse)
data Statistics = Stat{metrics::[Metric],
inspectionMetrics::[Metric],
count::Int,
step::Maybe Int}
type StatisticsState a = forall m. (MonadState Statistics m) => m a
type StatisticsStateIO a = forall m. (MonadState Statistics m, MonadIO m) => m a
updateMetrics :: (Metric -> Metric) -> Statistics -> Statistics
updateMetrics f stat = stat{metrics = map f (metrics stat),
inspectionMetrics = map f (inspectionMetrics stat)}
queryMetrics :: (Metric -> Maybe a) -> Statistics -> [a]
queryMetrics f stat = (mapMaybe f (metrics stat))
++ (mapMaybe f (inspectionMetrics stat))
mergeMetrics :: (Metric -> Metric -> Metric) -> Statistics -> Statistics -> Statistics
mergeMetrics f s1 s2 = s1 { metrics = zipWith f (metrics s1) (metrics s2)
, inspectionMetrics = zipWith f (inspectionMetrics s1) (inspectionMetrics s2)}
needsToPrintOut :: Statistics -> Bool
needsToPrintOut (Stat _ [] _ _) = False
needsToPrintOut (Stat _ _ _ Nothing) = False
needsToPrintOut (Stat _ _ iter (Just toi)) = iter > 0 && iter `mod` toi == 0
noStats :: Statistics -> Bool
noStats (Stat [] [] _ _) = True
noStats _ = False
emptyStats :: Statistics
emptyStats = Stat{metrics=[],
inspectionMetrics=[],
count=0,
step=Nothing}
initialStatisticsStateFor :: (MonadState Statistics m) => (m a -> Statistics -> b) -> m a -> b
initialStatisticsStateFor f = flip f emptyStats
addMetric :: Metric -> StatisticsState ()
addMetric newMetric = modify (\stat -> stat{metrics = (metrics stat)++[newMetric]})
addInspectionMetric :: Metric -> StatisticsState ()
addInspectionMetric newMetric = modify (\stat -> stat{inspectionMetrics = (inspectionMetrics stat)++[newMetric]})
setPrintOutInterval :: Int -> StatisticsState ()
setPrintOutInterval i = modify (resetInterval i)
where resetInterval 0 stat = stat{step = Nothing}
resetInterval x stat = stat{step = Just x}
printOutAllMetrics :: StatisticsStateIO ()
printOutAllMetrics = get >>= (liftIO . printOutAllMetrics')
printOutAllMetrics' :: Statistics -> IO ()
printOutAllMetrics' stats =
do
unless (noStats stats) $ do
liftIO $ putStrLn "(final statistics)"
liftIO $ printOutList (inspectionMetrics stats ++ metrics stats)
printOutInspectionMetrics :: StatisticsStateIO ()
printOutInspectionMetrics = do
shouldPrint <- gets needsToPrintOut
when ( shouldPrint ) $ do
liftIO $ putStr "(partial statistics: iteration "
iter <- gets count
liftIO . putStr . show $ iter
liftIO $ putStrLn ")"
ims <- gets inspectionMetrics
liftIO $ printOutList ims
printOutList :: Show a => [a] -> IO ()
printOutList ms = unless ( null ms ) $ do
let separator = "\n----------------------------------\n"
putStr "begin"
putStr separator
putStr $ concat $ intersperse separator $ map show ms
putStr separator
putStr "end\n"
showFinalStats :: Statistics -> String
showFinalStats stats = unlines $ map show $ metrics stats
data Metric = IntMetric String Int
instance Show Metric where
show (IntMetric s x) = s ++ " : " ++ (show x)
incrIntMetric :: String -> Int -> Metric -> Metric
incrIntMetric key i (IntMetric s c) | s == key = IntMetric s (c+i)
incrIntMetric _ _ m = m
queryIntMetric :: String -> Metric -> Maybe Int
queryIntMetric key (IntMetric s c) | s == key = Just c
queryIntMetric _ _ = Nothing
addIntMetrics :: Metric -> Metric -> Metric
addIntMetrics (IntMetric s1 c1) (IntMetric s2 c2) | s1 == s2 = IntMetric s1 (c1 + c2)
addIntMetrics s1 _ = s1