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 = Map Bucket (Double, Double, [(Double, Double)])
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 = (State Parse () -> Parse -> Parse)
-> Parse -> State Parse () -> Parse
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Parse () -> Parse -> Parse
forall s a. State s a -> s -> s
execState Parse
parse0 (State Parse () -> Parse)
-> ([Frame] -> State Parse ()) -> [Frame] -> Parse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Frame -> State Parse ()) -> [Frame] -> State Parse ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Frame -> State Parse ()
parseFrame ([Frame] -> Parse) -> [Frame] -> Parse
forall a b. (a -> b) -> a -> b
$ [Frame]
fs
  in  (
       Parse -> Int
count Parse
parse1
      , ((Double, Double, [(Double, Double)])
 -> (Double, Double, Maybe (Double, Double, Double)))
-> Map Bucket (Double, Double, [(Double, Double)])
-> Map Bucket (Double, Double, Maybe (Double, Double, Double))
forall a b. (a -> b) -> Map Bucket a -> Map Bucket b
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 (Double
 -> (Double, Double, [(Double, Double)])
 -> (Double, Double, Maybe (Double, Double, Double)))
-> Double
-> (Double, Double, [(Double, Double)])
-> (Double, Double, Maybe (Double, Double, Double))
forall a b. (a -> b) -> a -> b
$ Int -> Double
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, Double -> Double
forall a. Floating a => a -> a
sqrt (Double
s0 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
s1) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
s0, Maybe (Double, Double, Double)
slope)
  where
    m :: Double
m = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
values
    mt :: Double
mt = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
timesv
    ([Double]
timesv, [Double]
values) = [(Double, Double)] -> ([Double], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Double, Double)] -> [(Double, Double)]
forall a. [a] -> [a]
reverse [(Double, Double)]
samples)
    yvect :: Vector Double
yvect = [Double] -> Vector Double
forall a. [a] -> Vector a
V.fromList ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
m) [Double]
values)
    xvect :: Vector Double
xvect = [Double] -> Vector Double
forall a. [a] -> Vector a
V.fromList ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
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
              [] -> Maybe (Double, Double, Double)
forall a. Maybe a
Nothing
              -- Linear regression is meaningless with 1 sample
              [(Double, Double)
_] -> Maybe (Double, Double, Double)
forall a. Maybe a
Nothing
              [(Double, Double)]
_
                -- All values are the same leads to NaN r2
                | (Double -> Bool) -> Vector Double -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.all (Double
1 Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
==) Vector Double
yvect -> Maybe (Double, Double, Double)
forall a. Maybe a
Nothing
                | Bool
otherwise -> (Double, Double, Double) -> Maybe (Double, Double, Double)
forall a. a -> Maybe a
Just ((Double, Double, Double) -> Maybe (Double, Double, Double))
-> (Double, Double, Double) -> Maybe (Double, Double, Double)
forall a b. (a -> b) -> a -> b
$! Vector Double -> Vector Double -> (Double, Double, Double)
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
  (Sample -> StateT Parse Identity Double)
-> [Sample] -> State Parse ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Double -> Sample -> StateT Parse Identity Double
inserter Double
time) [Sample]
ls
  (Parse -> Parse) -> State Parse ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Parse -> Parse) -> State Parse ())
-> (Parse -> Parse) -> State Parse ()
forall a b. (a -> b) -> a -> b
$ \Parse
p -> Parse
p{ count :: Int
count = Parse -> Int
count Parse
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }

inserter :: Double -> Sample -> State Parse Double
inserter :: Double -> Sample -> StateT Parse Identity Double
inserter Double
t (Sample Bucket
k Double
v) = do
  Parse
p <- StateT Parse Identity Parse
forall s (m :: * -> *). MonadState s m => m s
get
  Parse -> State Parse ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Parse -> State Parse ()) -> Parse -> State Parse ()
forall a b. (a -> b) -> a -> b
$! Parse
p { totals :: Map Bucket (Double, Double, [(Double, Double)])
totals = (Maybe (Double, Double, [(Double, Double)])
 -> Maybe (Double, Double, [(Double, Double)]))
-> Bucket
-> Map Bucket (Double, Double, [(Double, Double)])
-> Map Bucket (Double, Double, [(Double, Double)])
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) }
  Double -> StateT Parse Identity Double
forall a. a -> StateT Parse Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> StateT Parse Identity Double)
-> Double -> StateT Parse Identity Double
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  = (Double, Double, [(Double, Double)])
-> Maybe (Double, Double, [(Double, Double)])
forall a. a -> Maybe a
Just ((Double, Double, [(Double, Double)])
 -> Maybe (Double, Double, [(Double, Double)]))
-> (Double, Double, [(Double, Double)])
-> Maybe (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! ((((,,) (Double
 -> Double
 -> [(Double, Double)]
 -> (Double, Double, [(Double, Double)]))
-> Double
-> Double
-> [(Double, Double)]
-> (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! Double
x) (Double
 -> [(Double, Double)] -> (Double, Double, [(Double, Double)]))
-> Double
-> [(Double, Double)]
-> (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x)) ([(Double, Double)] -> (Double, Double, [(Double, Double)]))
-> [(Double, Double)] -> (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! [(Double
t, Double
x)])
accum Double
t Double
x (Just (Double
y, Double
yy, [(Double, Double)]
ys)) = (Double, Double, [(Double, Double)])
-> Maybe (Double, Double, [(Double, Double)])
forall a. a -> Maybe a
Just ((Double, Double, [(Double, Double)])
 -> Maybe (Double, Double, [(Double, Double)]))
-> (Double, Double, [(Double, Double)])
-> Maybe (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! ((((,,) (Double
 -> Double
 -> [(Double, Double)]
 -> (Double, Double, [(Double, Double)]))
-> Double
-> Double
-> [(Double, Double)]
-> (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
y)) (Double
 -> [(Double, Double)] -> (Double, Double, [(Double, Double)]))
-> Double
-> [(Double, Double)]
-> (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yy)) ([(Double, Double)] -> (Double, Double, [(Double, Double)]))
-> [(Double, Double)] -> (Double, Double, [(Double, Double)])
forall a b. (a -> b) -> a -> b
$! (Double
t, Double
x)(Double, Double) -> [(Double, Double)] -> [(Double, Double)]
forall a. a -> [a] -> [a]
:[(Double, Double)]
ys)