module Eventlog.Total(total) where

import Control.Monad.State.Strict (State(), execState, get, put, modify)
import Data.Map (Map, empty, alter)
import Prelude hiding (init, lookup, lines, words, drop, length, readFile)

import Eventlog.Types
import qualified Data.Vector as V
import Statistics.LinearRegression


data Parse =
  Parse
  { Parse -> Map Bucket (Double, Double, [(Double, Double)])
totals    :: !(Map Bucket (Double, Double, [(Double, Double)])) -- compute running totals and total of squares
  , Parse -> Int
count     :: !Int                         -- number of frames
  , Parse -> [Double]
times     :: [Double]
  }

parse0 :: Parse
parse0 :: Parse
parse0 = Parse{ totals :: Map Bucket (Double, Double, [(Double, Double)])
totals = forall k a. Map k a
empty, count :: Int
count = Int
0, times :: [Double]
times = [] }

total :: [Frame] -> (Int, Map Bucket (Double, Double, Maybe (Double, Double, Double)))
total :: [Frame]
-> (Int,
    Map Bucket (Double, Double, Maybe (Double, Double, Double)))
total [Frame]
fs =
  let parse1 :: Parse
parse1 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState Parse
parse0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Frame -> State Parse ()
parseFrame forall a b. (a -> b) -> a -> b
$ [Frame]
fs
  in  (
       Parse -> Int
count Parse
parse1
      , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double
-> (Double, Double, [(Double, Double)])
-> (Double, Double, Maybe (Double, Double, Double))
stddev forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Parse -> Int
count Parse
parse1)) (Parse -> Map Bucket (Double, Double, [(Double, Double)])
totals Parse
parse1)
      )


stddev :: Double -> (Double, Double, [(Double, Double)]) -> (Double, Double, Maybe (Double, Double, Double))
stddev :: Double
-> (Double, Double, [(Double, Double)])
-> (Double, Double, Maybe (Double, Double, Double))
stddev Double
s0 (Double
s1, Double
s2, [(Double, Double)]
samples) = (Double
s1, forall a. Floating a => a -> a
sqrt (Double
s0 forall a. Num a => a -> a -> a
* Double
s2 forall a. Num a => a -> a -> a
- Double
s1 forall a. Num a => a -> a -> a
* Double
s1) forall a. Fractional a => a -> a -> a
/ Double
s0, Maybe (Double, Double, Double)
slope)
  where
    m :: Double
m = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
values
    mt :: Double
mt = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
timesv
    ([Double]
timesv, [Double]
values) = forall a b. [(a, b)] -> ([a], [b])
unzip (forall a. [a] -> [a]
reverse [(Double, Double)]
samples)
    yvect :: Vector Double
yvect = forall a. [a] -> Vector a
V.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Fractional a => a -> a -> a
/ Double
m) [Double]
values)
    xvect :: Vector Double
xvect = forall a. [a] -> Vector a
V.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Fractional a => a -> a -> a
/ Double
mt) [Double]
timesv)
    slope :: Maybe (Double, Double, Double)
slope = -- TODO: Distinguish these cases
            case [(Double, Double)]
samples of
              [] -> forall a. Maybe a
Nothing
              -- Linear regression is meaningless with 1 sample
              [(Double, Double)
_] -> forall a. Maybe a
Nothing
              [(Double, Double)]
_
                -- All values are the same leads to NaN r2
                | forall a. (a -> Bool) -> Vector a -> Bool
V.all (Double
1 forall a. Eq a => a -> a -> Bool
==) Vector Double
yvect -> forall a. Maybe a
Nothing
                | Bool
otherwise -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *).
Vector v Double =>
v Double -> v Double -> (Double, Double, Double)
linearRegressionRSqr Vector Double
xvect Vector Double
yvect




parseFrame :: Frame -> State Parse ()
parseFrame :: Frame -> State Parse ()
parseFrame (Frame Double
time [Sample]
ls) = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Double -> Sample -> State Parse Double
inserter Double
time) [Sample]
ls
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \Parse
p -> Parse
p{ count :: Int
count = Parse -> Int
count Parse
p forall a. Num a => a -> a -> a
+ Int
1 }

inserter :: Double -> Sample -> State Parse Double
inserter :: Double -> Sample -> State Parse Double
inserter Double
t (Sample Bucket
k Double
v) = do
  Parse
p <- forall s (m :: * -> *). MonadState s m => m s
get
  forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$! Parse
p { totals :: Map Bucket (Double, Double, [(Double, Double)])
totals = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter (Double
-> Double
-> Maybe (Double, Double, [(Double, Double)])
-> Maybe (Double, Double, [(Double, Double)])
accum Double
t Double
v) Bucket
k (Parse -> Map Bucket (Double, Double, [(Double, Double)])
totals Parse
p) }
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Double
v

accum :: Double -> Double -> Maybe (Double, Double, [(Double, Double)]) -> Maybe (Double, Double, [(Double, Double)])
accum :: Double
-> Double
-> Maybe (Double, Double, [(Double, Double)])
-> Maybe (Double, Double, [(Double, Double)])
accum Double
t Double
x Maybe (Double, Double, [(Double, Double)])
Nothing  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ((((,,) forall a b. (a -> b) -> a -> b
$! Double
x) forall a b. (a -> b) -> a -> b
$! (Double
x forall a. Num a => a -> a -> a
* Double
x)) forall a b. (a -> b) -> a -> b
$! [(Double
t, Double
x)])
accum Double
t Double
x (Just (Double
y, Double
yy, [(Double, Double)]
ys)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ((((,,) forall a b. (a -> b) -> a -> b
$! (Double
x forall a. Num a => a -> a -> a
+ Double
y)) forall a b. (a -> b) -> a -> b
$! (Double
x forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
+ Double
yy)) forall a b. (a -> b) -> a -> b
$! (Double
t, Double
x)forall a. a -> [a] -> [a]
:[(Double, Double)]
ys)