{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Eventlog.Bands (bands, series, bandsToSeries) where

import Control.Monad (forM_)
import Control.Monad.ST (runST)
import Data.Array.Base (unsafeFreezeSTUArray, (!), bounds)
import Data.Array.ST (writeArray, readArray, newArray)
import Data.Array.Unboxed (UArray)
import Data.Map (Map, lookup, size, foldrWithKey)
import Prelude hiding (lookup, lines, words, length)
import Eventlog.Types
import Data.HashTable.ST.Basic hiding (lookup)
import Data.Aeson hiding (Series)
import GHC.Generics
import Data.Set (Set, notMember)

bands :: Header -> Map Bucket Int -> [Frame] -> (UArray Int Double, UArray (Int, Int) Double)
bands :: Header
-> Map Bucket Int
-> [Frame]
-> (UArray Int Double, UArray (Int, Int) Double)
bands Header
h Map Bucket Int
bs [Frame]
frames = (forall s. ST s (UArray Int Double, UArray (Int, Int) Double))
-> (UArray Int Double, UArray (Int, Int) Double)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (UArray Int Double, UArray (Int, Int) Double))
 -> (UArray Int Double, UArray (Int, Int) Double))
-> (forall s. ST s (UArray Int Double, UArray (Int, Int) Double))
-> (UArray Int Double, UArray (Int, Int) Double)
forall a b. (a -> b) -> a -> b
$ do
  STUArray s Int Double
times <- (Int, Int) -> Double -> ST s (STUArray s Int Double)
forall i. Ix i => (i, i) -> Double -> ST s (STUArray s i Double)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
1, Header -> Int
hCount Header
h) Double
0
  STUArray s (Int, Int) Double
vals  <- ((Int, Int), (Int, Int))
-> Double -> ST s (STUArray s (Int, Int) Double)
forall i. Ix i => (i, i) -> Double -> ST s (STUArray s i Double)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray ((-Int
1,Int
1), (Map Bucket Int -> Int
forall k a. Map k a -> Int
Data.Map.size Map Bucket Int
bs, Header -> Int
hCount Header
h)) Double
0
  [(Int, Frame)] -> ((Int, Frame) -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [Frame] -> [(Int, Frame)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 ..] [Frame]
frames) (((Int, Frame) -> ST s ()) -> ST s ())
-> ((Int, Frame) -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (Frame Double
t [Sample]
ss)) -> do
    STUArray s Int Double -> Int -> Double -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Double
times Int
i Double
t
    [Sample] -> (Sample -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Sample]
ss ((Sample -> ST s ()) -> ST s ()) -> (Sample -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Sample Bucket
k Double
v) -> do
      case Bucket
k Bucket -> Map Bucket Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
`lookup` Map Bucket Int
bs of
        Maybe Int
Nothing -> STUArray s (Int, Int) Double -> (Int, Int) -> Double -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Int, Int) Double
vals (Int
0, Int
i) (Double -> ST s ()) -> (Double -> Double) -> Double -> ST s ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v) (Double -> ST s ()) -> ST s Double -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< STUArray s (Int, Int) Double -> (Int, Int) -> ST s Double
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s (Int, Int) Double
vals (Int
0, Int
i)
        Just Int
b  -> STUArray s (Int, Int) Double -> (Int, Int) -> Double -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s (Int, Int) Double
vals (Int
b, Int
i) Double
v
  UArray Int Double
times' <- STUArray s Int Double -> ST s (UArray Int Double)
forall s i e. STUArray s i e -> ST s (UArray i e)
unsafeFreezeSTUArray STUArray s Int Double
times
  UArray (Int, Int) Double
vals'  <- STUArray s (Int, Int) Double -> ST s (UArray (Int, Int) Double)
forall s i e. STUArray s i e -> ST s (UArray i e)
unsafeFreezeSTUArray STUArray s (Int, Int) Double
vals
  (UArray Int Double, UArray (Int, Int) Double)
-> ST s (UArray Int Double, UArray (Int, Int) Double)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (UArray Int Double
times', UArray (Int, Int) Double
vals')

bandsToSeries :: Map Bucket Int -> (UArray Int Double, UArray (Int, Int) Double)
              -> [Series]
bandsToSeries :: Map Bucket Int
-> (UArray Int Double, UArray (Int, Int) Double) -> [Series]
bandsToSeries Map Bucket Int
ks (UArray Int Double
ts, UArray (Int, Int) Double
vs) =
  let (Int
t1, Int
tn) = UArray Int Double -> (Int, Int)
forall i. Ix i => UArray i Double -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Double
ts
      go :: Bucket -> Int -> [Series] -> [Series]
go Bucket
k Int
v [Series]
rs = Bucket -> [(Double, Double)] -> Series
Series Bucket
k [(Double, Double)]
go_1 Series -> [Series] -> [Series]
forall a. a -> [a] -> [a]
: [Series]
rs
        where
          go_1 :: [(Double, Double)]
          go_1 :: [(Double, Double)]
go_1 = ((Int -> (Double, Double)) -> [Int] -> [(Double, Double)])
-> [Int] -> (Int -> (Double, Double)) -> [(Double, Double)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> (Double, Double)) -> [Int] -> [(Double, Double)]
forall a b. (a -> b) -> [a] -> [b]
map [Int
t1 .. Int
tn] ((Int -> (Double, Double)) -> [(Double, Double)])
-> (Int -> (Double, Double)) -> [(Double, Double)]
forall a b. (a -> b) -> a -> b
$ \Int
t -> (UArray Int Double
ts UArray Int Double -> Int -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
t, UArray (Int, Int) Double
vs UArray (Int, Int) Double -> (Int, Int) -> Double
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! (Int
v, Int
t))
  in (Bucket -> Int -> [Series] -> [Series])
-> [Series] -> Map Bucket Int -> [Series]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey Bucket -> Int -> [Series] -> [Series]
go (Bucket -> Int -> [Series] -> [Series]
go (Text -> Bucket
Bucket Text
"OTHER") Int
0 []) Map Bucket Int
ks

data Series = Series { Series -> Bucket
key :: Bucket, Series -> [(Double, Double)]
values :: [(Double, Double)] }
  deriving (Int -> Series -> ShowS
[Series] -> ShowS
Series -> String
(Int -> Series -> ShowS)
-> (Series -> String) -> ([Series] -> ShowS) -> Show Series
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Series -> ShowS
showsPrec :: Int -> Series -> ShowS
$cshow :: Series -> String
show :: Series -> String
$cshowList :: [Series] -> ShowS
showList :: [Series] -> ShowS
Show, [Series] -> Encoding
[Series] -> Value
Series -> Encoding
Series -> Value
(Series -> Value)
-> (Series -> Encoding)
-> ([Series] -> Value)
-> ([Series] -> Encoding)
-> ToJSON Series
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Series -> Value
toJSON :: Series -> Value
$ctoEncoding :: Series -> Encoding
toEncoding :: Series -> Encoding
$ctoJSONList :: [Series] -> Value
toJSONList :: [Series] -> Value
$ctoEncodingList :: [Series] -> Encoding
toEncodingList :: [Series] -> Encoding
ToJSON, (forall x. Series -> Rep Series x)
-> (forall x. Rep Series x -> Series) -> Generic Series
forall x. Rep Series x -> Series
forall x. Series -> Rep Series x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Series -> Rep Series x
from :: forall x. Series -> Rep Series x
$cto :: forall x. Rep Series x -> Series
to :: forall x. Rep Series x -> Series
Generic)

series :: Set Bucket -> [Frame] ->  [Series]
series :: Set Bucket -> [Frame] -> [Series]
series Set Bucket
ks [Frame]
fs = (forall s. ST s [Series]) -> [Series]
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s [Series]) -> [Series])
-> (forall s. ST s [Series]) -> [Series]
forall a b. (a -> b) -> a -> b
$ do
  HashTable s Bucket [(Double, Double)]
m <- ST s (HashTable s Bucket [(Double, Double)])
forall s k v. ST s (HashTable s k v)
new
  [Frame] -> (Frame -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Frame] -> [Frame]
forall a. [a] -> [a]
reverse [Frame]
fs) ((Frame -> ST s ()) -> ST s ()) -> (Frame -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Frame Double
t [Sample]
s) ->
    [Sample] -> (Sample -> ST s ()) -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Sample]
s ((Sample -> ST s ()) -> ST s ()) -> (Sample -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \(Sample Bucket
k Double
v) -> do
      let ins :: Maybe [(Double, Double)] -> (Maybe [(Double, Double)], ())
ins Maybe [(Double, Double)]
_ | Bucket -> Set Bucket -> Bool
forall a. Ord a => a -> Set a -> Bool
notMember Bucket
k Set Bucket
ks = (Maybe [(Double, Double)]
forall a. Maybe a
Nothing, ())
          ins Maybe [(Double, Double)]
Nothing = ([(Double, Double)] -> Maybe [(Double, Double)]
forall a. a -> Maybe a
Just [(Double
t, Double
v)]  , ())
          ins (Just [(Double, Double)]
ss) = ([(Double, Double)] -> Maybe [(Double, Double)]
forall a. a -> Maybe a
Just ((Double
t,Double
v) (Double, Double) -> [(Double, Double)] -> [(Double, Double)]
forall a. a -> [a] -> [a]
: [(Double, Double)]
ss), ())
      HashTable s Bucket [(Double, Double)]
-> Bucket
-> (Maybe [(Double, Double)] -> (Maybe [(Double, Double)], ()))
-> ST s ()
forall k s v a.
(Eq k, Hashable k) =>
HashTable s k v -> k -> (Maybe v -> (Maybe v, a)) -> ST s a
mutate HashTable s Bucket [(Double, Double)]
m Bucket
k Maybe [(Double, Double)] -> (Maybe [(Double, Double)], ())
ins
  ([Series] -> (Bucket, [(Double, Double)]) -> ST s [Series])
-> [Series]
-> HashTable s Bucket [(Double, Double)]
-> ST s [Series]
forall a k v s.
(a -> (k, v) -> ST s a) -> a -> HashTable s k v -> ST s a
foldM (\[Series]
r (Bucket
k,[(Double, Double)]
v) -> [Series] -> ST s [Series]
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bucket -> [(Double, Double)] -> Series
Series Bucket
k [(Double, Double)]
v Series -> [Series] -> [Series]
forall a. a -> [a] -> [a]
: [Series]
r)) [] HashTable s Bucket [(Double, Double)]
m