mandulia-0.4: src/StatsLogger.hs

{-
Mandulia -- Mandelbrot/Julia explorer
Copyright (C) 2010  Claude Heiland-Allen <claudiusmaximus@goto10.org>

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
-}

module StatsLogger(statsLogger, Logger, Statistics, time) where

import Prelude hiding (map)
import Data.Map (empty, insertWith', map, toAscList)
import Control.Concurrent.MVar (newMVar, modifyMVar_, readMVar)
import Data.Time (getCurrentTime, diffUTCTime)

type Logger = String -> Double -> IO ()
type Statistics = IO [(String, (Double, Double, Double))]

data Stats =
  Stats
    { count :: !Double
    , sumX  :: !Double
    , sumXX :: !Double
    }

stat :: Double -> Stats
stat x = Stats{ count = 1, sumX = x, sumXX = x * x }

combine :: Stats -> Stats -> Stats
combine s t =
  Stats
    { count = count s + count t
    , sumX  = sumX  s + sumX  t
    , sumXX = sumXX s + sumXX t
    }

stats :: Stats -> (Double, Double, Double)
stats s =
  let mean  = sumX  s / count s
      mean2 = sumXX s / count s
      stddev = sqrt $ mean2 - mean * mean
  in (count s, mean, stddev)

statsLogger :: IO (Logger, Statistics)
statsLogger = do
  v <- newMVar empty
  let logStats name value = modifyMVar_ v $ return . insertWith' combine name (stat value)
      getStats = readMVar v >>= return . toAscList . map stats
  return (logStats, getStats)

time :: IO a -> IO (Double, a)
time x = do
  t0 <- getCurrentTime
  r <- x
  t1 <- getCurrentTime
  return (realToFrac (diffUTCTime t1 t0), r)